Autor Beitrag
wulfskin
ontopic starontopic starontopic starontopic starontopic starontopic starontopic starhalf ontopic star
Beiträge: 1349
Erhaltene Danke: 1

Win XP
D5 Pers (SSL), D2005 Pro, C, C#
BeitragVerfasst: Sa 29.12.07 19:23 
Hallo,

ich habe jetzt schon zwei Komponenten ausprobiert (TComPort und TSerialPortNG), doch bei jedem Schreiben stürzt mein komplettes Betriebsystem mit Bluescreen ab (Fehlermeldung kann ich nicht lesen) (Win XP).
Lesen funktioniert soweit und auch das Schreiben geht mit Putty.

Hier ein Auszug aus der Senderoutine:
ausblenden Delphi-Quelltext
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
WriteFile(hCommPort,
                Data^,
                Size,
                fWrittenBytes,
                @WriteOverlapped)

//weiter oben      
hCommPort := CreateFile(StrPCopy(CommPortName,'\\.\'+Copy(fCommPort,1,79)),
            GENERIC_READ OR GENERIC_WRITE,
            0,
            nil,
            OPEN_EXISTING,
            FILE_FLAG_OVERLAPPED,0);
Er schreibt wohl irgendwo hin, nur nicht dahin wo er soll. Zum Beispiel war nach einem Absturz eine Unit mit Nullen überschrieben...

Ich weiß, es ist die Suche nach der Nadel im Heuhaufen, aber vielleicht hat jemand schon ähnliche Erfahrungen gemacht.

Viele Grüße,
Hans-Peter
Mitmischer 1703
ontopic starontopic starontopic starontopic starontopic starontopic starofftopic starofftopic star
Beiträge: 754
Erhaltene Danke: 19

Win 7, Debian
Delphi Prism, Delphi 7, RAD Studio 2009 Academic, C#, C++, Java, HTML, PHP
BeitragVerfasst: Sa 29.12.07 19:49 
Das teste ich jetzt nicht :shock:!

_________________
Die Lösung ist nicht siebzehn.
MAlsleben
ontopic starontopic starontopic starontopic starontopic starontopic starontopic starhalf ontopic star
Beiträge: 302

W2k,WinXP
D3 - DXE3 Enterprise
BeitragVerfasst: Di 01.01.08 12:49 
Hi,

was sagt denn der BlueScreen aus? Kann man ja so einstellen, das der Rechner nicht gleich neu startet.

Gruss Micha

_________________
Viele Wege führen nach Rom.
Luckie
Ehemaliges Mitglied
Erhaltene Danke: 1



BeitragVerfasst: Di 01.01.08 13:56 
Direkte Hardwarezugriffe sind unter NT Systemen nur über einen Treiber möglich. Allerdings sollte ein Programm im User Mode keine Blue Screen auslösen können. Ich gehe mal davon aus, dass du den Treiber falsch ansprichst und er diesen Fehler nicht abfängt. Guck dir noch mal die Dokumenttaion zu den Komponenten an.
M. Raab
ontopic starontopic starontopic starontopic starontopic starontopic starontopic starhalf ontopic star
Beiträge: 334
Erhaltene Danke: 1

WIN 7
Delphi XE
BeitragVerfasst: Di 01.01.08 14:34 
Hallo WULSKIN


ich habe ebenfalls eine Komponente - die funzt unter WIN XP und VISTA 32 und 64.


Gruss


Markus



ausblenden volle Höhe Delphi-Quelltext
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
147:
148:
149:
150:
151:
152:
153:
154:
155:
156:
157:
158:
159:
160:
161:
162:
163:
164:
165:
166:
167:
168:
169:
170:
171:
172:
173:
174:
175:
176:
177:
178:
179:
180:
181:
182:
183:
184:
185:
186:
187:
188:
189:
190:
191:
192:
193:
194:
195:
196:
197:
198:
199:
200:
201:
202:
203:
204:
205:
206:
207:
208:
209:
210:
211:
212:
213:
214:
215:
216:
217:
218:
219:
220:
221:
222:
223:
224:
225:
226:
227:
228:
229:
230:
231:
232:
233:
234:
235:
236:
237:
238:
239:
240:
241:
242:
243:
244:
245:
246:
247:
248:
249:
250:
251:
252:
253:
254:
255:
256:
257:
258:
259:
260:
261:
262:
263:
264:
265:
266:
267:
268:
269:
270:
271:
272:
273:
274:
275:
276:
277:
278:
279:
280:
281:
282:
283:
284:
285:
286:
287:
288:
289:
290:
291:
292:
293:
294:
295:
296:
297:
298:
299:
300:
301:
302:
303:
304:
305:
306:
307:
308:
309:
310:
311:
312:
313:
314:
315:
316:
317:
318:
319:
320:
321:
322:
323:
324:
325:
326:
327:
328:
329:
330:
331:
332:
333:
334:
335:
336:
337:
338:
339:
340:
341:
342:
343:
344:
345:
346:
347:
348:
349:
350:
351:
352:
353:
354:
355:
356:
357:
358:
359:
360:
361:
362:
363:
364:
365:
366:
367:
368:
369:
370:
371:
372:
373:
374:
375:
376:
377:
378:
379:
380:
381:
382:
383:
384:
385:
386:
387:
388:
389:
390:
391:
392:
393:
394:
395:
396:
397:
398:
399:
400:
401:
402:
403:
404:
405:
406:
407:
408:
409:
410:
411:
412:
413:
414:
415:
416:
417:
418:
419:
420:
421:
422:
423:
424:
425:
426:
427:
428:
429:
430:
431:
432:
433:
434:
435:
436:
437:
438:
439:
440:
441:
442:
443:
444:
445:
446:
447:
448:
449:
450:
451:
452:
453:
454:
455:
456:
457:
458:
459:
460:
461:
462:
463:
464:
465:
466:
467:
468:
469:
470:
471:
472:
473:
474:
475:
476:
477:
478:
479:
480:
481:
482:
483:
484:
485:
486:
487:
488:
489:
490:
491:
492:
493:
494:
495:
496:
497:
498:
499:
500:
501:
502:
503:
504:
505:
506:
507:
508:
509:
510:
511:
512:
513:
514:
515:
516:
517:
518:
519:
520:
521:
522:
523:
524:
525:
526:
527:
528:
529:
530:
531:
532:
533:
534:
535:
536:
537:
538:
539:
540:
541:
542:
543:
544:
545:
546:
547:
548:
549:
550:
551:
552:
553:
554:
555:
556:
557:
558:
559:
560:
561:
562:
563:
564:
565:
566:
567:
568:
569:
570:
571:
572:
573:
574:
575:
576:
577:
578:
579:
580:
581:
582:
583:
584:
585:
586:
587:
588:
589:
590:
591:
592:
593:
594:
595:
596:
597:
598:
599:
600:
601:
602:
603:
604:
605:
606:
607:
608:
609:
610:
611:
612:
613:
614:
615:
616:
617:
618:
619:
620:
621:
622:
623:
624:
625:
626:
627:
628:
629:
630:
631:
632:
633:
634:
635:
636:
637:
638:
639:
640:
641:
642:
643:
644:
645:
646:
647:
648:
649:
650:
651:
652:
653:
654:
655:
656:
657:
unit comm_async;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;

const
  MAXPORTS = 10;                    // Ünterstützung auf COM1 - COM10 begrenzt
  WM_CommEvent = WM_USER + $1000;  // CommEreignis als Nachricht
  WM_CommChar = WM_USER + $1001;   // Zeichen empfangen
  WM_CommErr = WM_USER + $1002;     // Fehler in Comm

  //DCB.Flags:
  dcb_Binary           = $0001;                                  // Bit  1
  dcb_Parity           = $0002;                                  // Bit  2
  dcb_OutxCtsFlow      = $0004;                                  // Bit  3
  dcb_OutxDsrFlow      = $0008;                                  // Bit  4
  dcb_DtrControl       = $0010;  // 2 Bits  (0x10, 0x20)         // Bit  5+6
  dcb_DsrSensitvity    = $0040;                                  // Bit  7
  dcb_TXContinueOnXOff = $0080;                                  // Bit  8
  dcb_OutX             = $0100;                                  // Bit  9
  dcb_InX              = $0200;                                  // Bit 10
  dcb_ErrorChar        = $0400;                                  // Bit 11
  dcb_Null             = $0800;                                  // Bit 12
  dcb_RtsControl       = $1000;  // 2 Bits (0x1000, 0x2000)      // Bit 13+14
  dcb_AbortOnError     = $4000;                                  // Bit 15
  // Bits 16 - 32 reserviert !!!

type
  PVars = ^TVars;
  TVars = record
    Connected:  Boolean;        // Verbindungszustand
    InBuffer,                   // Größe des Empfangspuffers (Driver)
    OutBuffer,                  // Größe des SendePuffers (Driver)
    CommEventMask: DWord;       // Ereignismaske für Port
    PortNr: Byte;               // PortNr.
    hWindow:    hWnd;           // Handle zum HilfsFenster
    hComm,                      // Handle der Schnittstelle
    hWatchTh,                   // Handle zum ÜberwachungsThread
    hPostEv,                    // Handle zum NotificationEvent
    hWatchEv:   THandle;        // Handle zum Überwachungsereignis
    WatchThID:  DWord;          // ID des ÜberwachungsThread
    OvWrite,                    // Struktur für asynchrones Schreiben
    OvRead:     TOverlapped;    // Struktur für asynchrones Lesen
  end;

  TBaudRate = (cbr110, cbr300, cbr600, cbr1200, cbr2400, cbr4800, cbr9600,
               cbr14400, cbr19200, cbr38400, cbr56000, cbr57600, cbr115200,
               cbr128000, cbr256000);
  TParity = (cpNONE, cpODD, cpEVEN, cpMARK, cpSPACE);
  TStopBits = (csbONE, csbONE5, csbTWO);
  TFlowControl = (cfcNone, cfcHardware, cfcXonXoff);
  TEventMask = set of (cevBREAK,  cevCTS,  cevDSR,  cevERR,  cevRING, cevRLSD,
                       cevRXCHAR, cevRXFLAG, cevTXEMPTY);
  //Event-Declaration
  TOnCommEvent = procedure(Sender: TObject; Events, State: DWord) of object;
  TOnCharReceived = procedure(Sender: TObject; cbInQue: DWord) of object;
  TOnCommError = procedure(Sender: TObject; ErrorCode: DWord) of object;

type
  TComm = class(TComponent)
  private
    { Private-Deklarationen }
    D: TVars;
    fOSVersion: TOSVersionInfo;
    fCommTimeouts: TCommTimeouts;
    fDCB: TDCB;
    fFlowControl: TFlowControl;
    fOnCommEvent: TOnCommEvent;
    fOnCharReceived: TOnCharReceived;
    fOnCommError: TOnCommError;
  protected
    { Protected-Deklarationen }
    procedure WndProc(var Msg: TMessage);
    procedure SetupParams;
    // Ereignis-Routinen
    procedure DoCommEvent(Events, State: DWord); dynamic;
    procedure DoCharReceived(Len: DWord); dynamic;
    procedure DoCommError(ErrorCode: DWord); dynamic;
    // Property-Routinen
    procedure SetPortNr(Val: Byte);
    function GetBaudRate: TBaudRate;
    procedure SetBaudRate(Val: TBaudRate);
    procedure SetByteSize(Val: Byte);
    function GetParity: TParity;
    procedure SetParity(Val: TParity);
    function GetStopBits: TStopBits;
    procedure SetStopBits(Val: TStopBits);
    procedure SetInBufSize(Val: DWord);
    procedure SetOutBufSize(Val: DWord);
    function GetFlowControl: TFlowControl;
    procedure SetFlowControl(Value: TFlowControl);
    function GetEventMask: TEventMask;
    procedure SetEventMask(Val: TEventMask);
  public
    { Public-Deklarationen }
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    // Öffnen / Schließen Comm
    function Open: boolean;
    procedure Close;
    // Lesen / Schreiben
    function Read(P: Pointer; Len: DWord): DWord;
    function Write(P: Pointer; Len: DWord): DWord;
    // Standard-Dialog
    procedure SetupDlg;
  published
    { Published-Deklarationen }
    property Port: Byte read D.PortNr write SetPortNr;
    // DCB-Struktur
    property BaudRate: TBaudRate read GetBaudRate write SetBaudRate;
    property ByteSize: Byte read fDCB.ByteSize
                            write SetByteSize;
    property Parity: TParity read GetParity write SetParity;
    property StopBits: TStopBits read GetStopBits write SetStopBits;
    property FlowControl: TFlowControl read GetFlowControl write SetFlowControl;
    property XonChar: Char read fDCB.XonChar write fDCB.XonChar;
    property XoffChar: Char read fDCB.XoffChar write fDCB.XoffChar;
    property ErrorChar: Char read fDCB.ErrorChar write fDCB.ErrorChar;
    property EofChar: Char read fDCB.EofChar write fDCB.EofChar;
    property EvtChar: Char read fDCB.EvtChar write fDCB.EvtChar;
    property XOnLimit: Word read fDCB.XOnLim write fDCB.XOnLim;
    property XOffLimit: Word read fDCB.XOffLim write fDCB.XOffLim;
    property Connected: Boolean read D.Connected;
    // Driver-Buffers
    property InBufSize: DWord read D.InBuffer write SetInBufSize;
    property OutBufSize: DWord read D.OutBuffer write SetOutBufSize;
    // Ereignismaske
    property EventMask: TEventMask read GetEventMask write SetEventMask;
    { Ereignisse }
    property OnCommEvent: TOnCommEvent read fOnCommEvent write fOnCommEvent;
    property OnCharReceived: TOnCharReceived read fOnCharReceived write fOnCharReceived;
    property OnCommError: TOnCommError read fOnCommError write fOnCommError;
  end;

// 2. Thread zur Ereignisüberwachung
function CommWatch(PData: Pointer): LongInt; stdcall;

procedure Register;

implementation

constructor TComm.Create(AOwner: TComponent);
const
  SetDCB : PChar = 'baud=9600 parity=n data=8 stop=1';
var
  CC: TCommConfig;
begin
  inherited Create(AOwner);
   FillMemory(@D, SizeOf(D), 0);           // Struktur def. füllen
   D.hWindow:= AllocateHWnd(WndProc);      // HilfsFenster erzeugen
   //  I/O-Events für overlapped write & read
  D.OvWrite.hEvent:= CreateEvent(nil,     // Keine Security-Attr.
                                 True,     // manuell. Reset
                                 False,    // nonsignaled
                                 nil);     // No Name
   D.OvRead.hEvent:= CreateEvent(nil, True, False, nil);
  //  Event für CommNotification
   D.hPostEv:= CreateEvent(nil,            // Keine Security-Attr.
                          True,           // manuell. Reset
                          True,           // signaled
                           nil);           // No Name
   //  Füllen der Strukturen mit StdWerten
   fDCB.dcbLength:= SizeOf(fDCB);
  FillMemory(@CC, SizeOf(CC), 0);
  CC.dwSize:= SizeOf(CC);
  fOSVersion.dwOSVersionInfoSize:= SizeOf(fOSVersion);
  GetVersionEx(fOSVersion);
  if (fOSVersion.dwPlatformID = VER_PLATFORM_WIN32_NT)  and
                      (fOSVersion.dwMajorVersion < 4then
    BuildCommDCB('baud=9600 parity=N data=8 stop=1', fDCB)
  else begin
    GetDefaultCommConfig('COM1', CC, CC.dwSize);
    fDCB:= CC.DCB;
  end;
  D.PortNr:= 1;
  D.InBuffer:= 2048;
   D.OutBuffer:= 2048;
   D.CommEventMask:= ev_RXCHAR;
end//Create

destructor TComm.Destroy;
begin
  //  Abbau der Event-Objecte
  with D do begin
    if Connected then Close;
    CloseHandle(OvWrite.hEvent);
    CloseHandle(OvRead.hEvent);
    CloseHandle(hPostEv);
  end;
  DeallocateHWnd(D.hWindow);      // Fenster zerstören
  inherited Destroy;
end//Destroy

function TComm.Open: boolean;
var
  ModemStat: DWord;
begin
  if not D.Connected then begin
    // Port mit CreateFile öffnen
    D.hComm:= CreateFile(PChar('\\.\COM' + IntToStr(D.PortNr) + #0),  //Port
                         GENERIC_READ or GENERIC_WRITE, // R/W-Zugriff
                         0,                             // exclusiv
                         nil,                           // Security
                         OPEN_EXISTING,                 // muß vorhanden sein
                         FILE_FLAG_OVERLAPPED,          // asynchron
                         0);                            // keine Vorlage
    if D.hComm <> INVALID_HANDLE_VALUE then begin
      with D do begin
        Connected:= True;
        SetupParams;
        // Überwachungsthread erzeugen
        hWatchTh:= CreateThread(nil,              // keine Security
                                0,                // Stack
                                @CommWatch,       // Thread-Funktion
                                @D,               // Funktions-Parameter
                                0,                // Create-Flags
                                WatchThID);       // Thread-ID
        // Thread-Priorität senken
        SetThreadPriority(hWatchTh, THREAD_PRIORITY_BELOW_NORMAL);
        ResumeThread(hWatchTh);
        // DTR setzen
        EscapeCommFunction(hComm, SETDTR);
        GetCommModemStatus(hComm, ModemStat);
        DoCommEvent($FFFFFFFF, ModemStat);        // Ereignis
      end;
    end;
    Result:= D.Connected;
  end else Result:= False;
end//Open

procedure TComm.Close;
begin
  if D.Connected then begin
    D.Connected:= False;

    SetCommMask(D.hComm, 0);            // Ereignismaske löschen
    // Thread-Priorität erhöhen -> Wartezeit kürzer
    SetThreadPriority(D.hWatchTh, THREAD_PRIORITY_NORMAL);
    ResumeThread(D.hWatchTh);




    ///////////////////////////////////////////////////////////////////////////////////////////

    /// 06.01.2004 Zeile entfernt
    // Warten, bis Thread beendet
    
    while D.WatchThID <> 0 do begin end;

    /////////////////////////////////////////////
    ////////////////////////////////////////////////////////////////////////////////////////////////

    // DTR löschen
    EscapeCommFunction(D.hComm, CLRDTR);
    // COM-Puffer löschen
    PurgeComm(D.hComm,                  // Handle von CreateFile
              PURGE_TXABORT or          // laufende Schreib-Op. abbrechen
              PURGE_RXABORT or           // laufende Lese-Op. abbrechen
              PURGE_TXCLEAR or           // Sende-Puffer löschen
              PURGE_RXCLEAR);            // Empfangs-Puffer löschen
    CloseHandle(D.hComm);                // COM schließen
  end;
end//Close

function TComm.Read(P: Pointer; Len: DWord): DWord;
var
  State: Boolean;
  ErrorFlags, ReadBytes, MaxLen: DWord;
  ComStat: TComStat;
begin
  if D.Connected then begin
    // Status und Fehler der COM abfragen
    ClearCommError(D.hComm,             // Handle von CreateFile
                    ErrorFlags,         // Fehler
                    @ComStat);          // Status
    // Größe des Datenpuffers bestimmen (= Anzahl zu lesender Zeichen)
    if ComStat.cbInQue > Len then
      MaxLen:= Len
    else
      MaxLen:= ComStat.cbInQue;
    State:= ReadFile(D.hComm,           // Handle von CreateFile
                     P^,                // Datenpuffer (Prog.)
                     MaxLen,            // Größe des Datenpuffers
                     ReadBytes,         // gelesene Zeichen
                     @(D.OvRead));      // Overlapped-Record
    // async. Operation läuft noch ?
    if not State and (GetLastError = ERROR_IO_PENDING) then
      // Warten auf Op.-Ende
      if WaitForSingleObject(D.OvRead.hEvent, 1000) <> 0 then
        ReadBytes:= 0
      else Begin
        // Ergebnis der async. Op.
        GetOverlappedResult(D.hComm,    // Handle von CreateFile
                            D.OvRead,   // Overlapped-Record
                            ReadBytes,  // Gelesene Bytes
                            False);     // Wait1
//        nicht für Named Pipes und Comm. Devices
//        D.OvRead.OffSet:= D.OvRead.Offset + ReadBytes;
      end;
    Result:= ReadBytes;
  end
  else Result:= 0;
end//Read

function TComm.Write(P: Pointer; Len: DWord): DWord;
var
  State: Boolean;
  WrittenBytes: DWord;
begin
  if D.Connected then begin
    State:= WriteFile(D.hComm,          // Handle von CreateFile
                      P^,               // Datenpuffer (Prog.)
                      Len,              // Größe des Datenpuffers
                      WrittenBytes,     // geschriebene Bytes
                      @(D.OvWrite));    // Overlapped-Record
    // async. Operation läuft noch ?
    if not State and (GetLastError = ERROR_IO_PENDING) then
      // Warten auf Op.-Ende
      if WaitForSingleObject(D.OvWrite.hEvent, 1000) <> 0 then
        WrittenBytes:=0
      else begin
        // Ergebnis der async. Op.
        GetOverlappedResult(D.hComm,     // Handle von CreateFile
                            D.OvWrite,   // Overlapped-Record
                            WrittenBytes,// Gelesene Bytes
                            False);      // Wait1
//        nicht für Named Pipes und Comm. Devices
//        D.OvWrite.Offset:= D.OvWrite.Offset + WrittenBytes;
      end;
    Result:= WrittenBytes;
  end
  Else Result:= 0;
end//Write

procedure TComm.SetupDlg;
var
  CommConfig: TCommConfig;
begin
  if (fOSVersion.dwPlatformID = VER_PLATFORM_WIN32_NT)  or
                      (fOSVersion.dwMajorVersion >= 4then begin
    FillMemory(@CommConfig, SizeOf(CommConfig), 0);
    CommConfig.dwSize:= SizeOf(CommConfig);
    if D.Connected then
      GetCommConfig(D.hComm, CommConfig, CommConfig.dwSize)
    else
      GetDefaultCommConfig(PChar('COM' + IntToStr(D.PortNr) + #0),
                  CommConfig,
                  CommConfig.dwSize);
    if CommConfigDialog(PChar('COM' + IntToStr(D.PortNr) + #0),
                        0,
                        CommConfig) then  begin // Korrektur der Flags
      fDCB:= CommConfig.DCB;
      SetupParams;
    end;
  end;
end//SetupDlg

procedure TComm.SetupParams;
begin
  with D do
    if Connected then begin
      SetCommState(hComm, fDCB);
      SetupComm(hComm, InBuffer, OutBuffer);
      // SetCommTimeOuts(hComm, fCommTimeOuts);
    end;
end//Setup

{Fensterprozedur für Hilfsfenster}
procedure TComm.WndProc(var Msg: TMessage);
begin
  with Msg do
    case Msg of
      WM_CommEvent:
        DoCommEvent(wParam, lParam);                  // Ereignis
      WM_CommChar:
        if lParam = $FF then DoCharReceived(wParam);  // Zeichen
      WM_CommErr:
        if lParam = $FF then DoCommError(wParam);     // Fehler
      else Result:= DefWindowProc(D.hWindow, Msg, wParam, lParam);
    end//case
end//WndProc

procedure TComm.DoCommEvent(Events, State: DWord);
begin
  if Assigned(FOnCommEvent) then                      // Ereignis
    FOnCommEvent(Self, Events, State);
  SetEvent(D.hPostEv);  //Sync
end// DoCommEvent

procedure TComm.DoCharReceived(Len: DWord);
begin
  if Assigned(FOnCharReceived) then                    // Zeichen
    FOnCharReceived(Self, Len);
  SetEvent(D.hPostEv);  //Sync
end;

procedure TComm.DoCommError(ErrorCode: DWord);
begin
  if Assigned(FOnCommError) then                      // Fehler
    FOnCommError(Self, ErrorCode);
  SetEvent(D.hPostEv);  //Sync
end;

//Threadfunktion zur Ereignisüberwachung
function CommWatch(PData: Pointer): LongInt; stdcall;
var
  D: PVars;
  OS: TOverlapped;
  EventMask,
  Transfer: DWord;
  ComStat: TComStat;
  ModemStat,
  ErrorCode: DWord;
begin
  D:= PData;
  FillMemory(@OS, SizeOf(OS), 0);
  OS.hEvent:= CreateEvent(nil,       // keine Security
                          True,      // manuell. Reset
                          False,     // nonSignaled
                          nil);      // noname
  // Maske muß immer im Überwachungs-Thread gesetzt werden, sonst Fehler !!!
  SetCommMask(D^.hComm, D^.CommEventMask);
  // Schleife, bis COM geschlossen wird
  while D^.Connected do begin
    EventMask:= 0;
    // Warten auf Ereignis (async. !!!)
    if not WaitCommEvent(D^.hComm,  // Handle von CreateFile
                         EventMask, // Ereignismaske
                         @OS) then  // Event-Record
      // async. Op. Läuft noch ???
      if ERROR_IO_PENDING = GetLastError then begin
        // Ergenis der async. Op.
        GetOverlappedResult(D^.hComm, OS, Transfer, True);
        OS.Offset:= OS.Offset + Transfer;
      end;
    if EventMask <> 0 then begin
      ClearCommError(D^.hComm, ErrorCode, @ComStat);
      if EventMask and EV_ERR = EV_ERR then begin            // Fehler
        // Sync. mit Haupt-Thread (Warten, bis letztes Ereignis bearbeitet)
        WaitForSingleObject(D^.hPostEv, $FFFFFFFF);
        ResetEvent(D^.hPostEv);
        PostMessage(D^.hWindow, WM_CommErr, ErrorCode, $FF);
      end;
      if EventMask and EV_RXCHAR = EV_RXCHAR then begin     // Empfang
        // Sync. mit Haupt-Thread (Warten, bis letztes Ereignis bearbeitet)
        WaitForSingleObject(D^.hPostEv, $FFFFFFFF);
        ResetEvent(D^.hPostEv);
        PostMessage(D^.hWindow, WM_CommChar, ComStat.cbInQue, $FF);
      end;
      if EventMask and (EV_RXCHAR or EV_ERR) = 0 then begin // andere Ereignisse
        // Sync. mit Haupt-Thread (Warten, bis letztes Ereignis bearbeitet)
        GetCommModemStatus(D^.hComm, ModemStat);
        WaitForSingleObject(D^.hPostEv, $FFFFFFFF);
        ResetEvent(D^.hPostEv);
        PostMessage(D^.hWindow, WM_CommEvent, EventMask, ModemStat);
      end;
    end//if
  end;
  CloseHandle(OS.hEvent);
  D^.hWatchTh:= 0;   // Selbstzerstörung anzeigen (Sync. mit Comm.Close)
  D^.WatchThID:= 0;
  Result:= LongInt(True);
end//CommWatch-Thread


{ Property-Routinen }
procedure TComm.SetPortNr(Val: Byte);
begin
  if not D.Connected then      // nur
    if (Val <> D.PortNr) and (Val > 0and (Val <= MAXPORTS) then begin
      D.PortNr:= Val;
    end;
end;

function TComm.GetBaudRate: TBaudRate;
begin
  case fDCB.BaudRate of
    cbr_110:    Result:= cbr110;
    cbr_300:    Result:= cbr300;
    cbr_600:    Result:= cbr600;
    cbr_1200:   Result:= cbr1200;
    cbr_2400:   Result:= cbr2400;
    cbr_4800:   Result:= cbr4800;
    cbr_9600:   Result:= cbr9600;
    cbr_14400:  Result:= cbr14400;
    cbr_19200:  Result:= cbr19200;
    cbr_38400:  Result:= cbr38400;
    cbr_56000:  Result:= cbr56000;
    cbr_57600:  Result:= cbr57600;
    cbr_115200: Result:= cbr115200;
    cbr_128000: Result:= cbr128000;
    else Result:= cbr256000;
  end//case
end;

procedure TComm.SetBaudRate(Val: TBaudRate);
begin
  with fDCB do
    case Val of
      cbr110:     BaudRate:= cbr_110;
      cbr300:     BaudRate:= cbr_300;
      cbr600:     BaudRate:= cbr_600;
      cbr1200:    BaudRate:= cbr_1200;
      cbr2400:    BaudRate:= cbr_2400;
      cbr4800:    BaudRate:= cbr_4800;
      cbr9600:    BaudRate:= cbr_9600;
      cbr14400:   BaudRate:= cbr_14400;
      cbr19200:   BaudRate:= cbr_19200;
      cbr38400:   BaudRate:= cbr_38400;
      cbr56000:   BaudRate:= cbr_56000;
      cbr57600:   BaudRate:= cbr_57600;
      cbr115200:  BaudRate:= cbr_115200;
      cbr128000:  BaudRate:= cbr_128000;
      cbr256000:  BaudRate:= cbr_256000;
    end//case
  SetupParams;
end;

procedure TComm.SetByteSize(Val: Byte);
begin
  if Val <> fDCB.ByteSize then
    if (Val >= 3and (Val <= 8then begin
      fDCB.ByteSize:= Val;
      SetupParams;
    end;
end;

function TComm.GetParity: TParity;
begin
  case fDCB.Parity of
    ODDPARITY   : Result:= cpODD;
    EVENPARITY  : Result:= cpEVEN;
    MARKPARITY  : Result:= cpMARK;
    SPACEPARITY : Result:= cpSPACE;
  else Result:= cpNONE;
  end//case
end;

procedure TComm.SetParity(Val: TParity);
begin
  with fDCB do begin
    Flags:= Flags or dcb_Parity;
    case Val of
      cpODD   : Parity:= ODDPARITY;
      cpEVEN  : Parity:= EVENPARITY;
      cpMARK  : Parity:= MARKPARITY;
      cpSpace : Parity:= SPACEPARITY;
    else
      begin
        Parity:= NOPARITY;
        Flags:= Flags and (not(Word(dcb_Parity)));
      end;
    end//case
  end//with
  SetupParams;
end;

function TComm.GetStopBits: TStopBits;
begin
  case fDCB.StopBits of
    ONESTOPBIT   : Result:= csbONE;
    ONE5STOPBITS : Result:= csbONE5;
  else Result:= csbTWO;
  end//case
end;

procedure TComm.SetStopBits(Val: TStopBits);
begin
  with fDCB do
    case Val of
      csbONE  : StopBits:= ONESTOPBIT;
      csbONE5 : StopBits:= ONE5STOPBITS;
    else StopBits:= TWOSTOPBITS;
    end//case
  SetupParams;
end;

procedure TComm.SetInBufSize(Val: DWord);
begin
  if Val > 0 then begin
    D.InBuffer:= Val;
    SetupParams;
  end;
end;

procedure TComm.SetOutBufSize(Val: DWord);
begin
  if Val > 0 then begin
    D.OutBuffer:= Val;
    SetupParams;
  end;
end;

function TComm.GetFlowControl: TFlowControl;
begin
  with fDCB do begin
    if (Flags and $2000 = $2000then Result:= cfcHardware else
      if (Flags and $300 = $300then Result:= cfcXonXoff else
        Result:= cfcNone;
  end;
end;

procedure TComm.SetFlowControl(Value: TFlowControl);
begin
//  if Value = FFlowControl then exit;
  FFlowControl:= Value;
  with fDCB do begin
    Flags:= Flags and $4C83;
    case FFlowControl of
      cfcNone     : Flags:= Flags or $11;   // DtrControl + Binary
      cfcHardware : Flags:= FLags or $2015// RTS_Handshake + DtrControl + Binary
      cfcXonXoff  : Flags:= Flags or $311;  // OutX + InX + DtrControl + Binary
    end;
  end;
  SetupParams;
end;

function TComm.GetEventMask: TEventMask;
begin
  Result:= [];
  if (EV_BREAK and D.CommEventMask) =EV_BREAK then include(Result, cevBREAK);
  if (EV_CTS and D.CommEventMask) = EV_CTS then include(Result, cevCTS);
  if (EV_DSR and D.CommEventMask) = EV_DSR then include(Result, cevDSR);
  if (EV_ERR and D.CommEventMask) = EV_ERR then include(Result, cevERR);
  if (EV_RING and D.CommEventMask) = EV_RING then include(Result, cevRING);
  if (EV_RLSD and D.CommEventMask) = EV_RLSD then include(Result, cevRLSD);
  if (EV_RXCHAR and D.CommEventMask) = EV_RXCHAR then include(Result, cevRXCHAR);
  if (EV_RXFLAG and D.CommEventMask) = EV_RXFLAG then include(Result, cevRXFLAG);
  if (EV_TXEMPTY and D.CommEventMask) = EV_TXEMPTY then include(Result, cevTXEMPTY);
end;

procedure TComm.SetEventMask(Val: TEventMask);
begin
  D.CommEventMask:= 0;
  if cevBREAK   in Val then D.CommEventMask:= D.CommEventMask or EV_BREAK;
  if cevCTS     in Val then D.CommEventMask:= D.CommEventMask or EV_CTS;
  if cevDSR     in Val then D.CommEventMask:= D.CommEventMask or EV_DSR;
  if cevERR     in Val then D.CommEventMask:= D.CommEventMask or EV_ERR;
  if cevRING    in Val then D.CommEventMask:= D.CommEventMask or EV_RING;
  if cevRLSD    in Val then D.CommEventMask:= D.CommEventMask or EV_RLSD;
  if cevRXCHAR  in Val then D.CommEventMask:= D.CommEventMask or EV_RXCHAR;
  if cevRXFLAG  in Val then D.CommEventMask:= D.CommEventMask or EV_RXFLAG;
  if cevTXEMPTY in Val then D.CommEventMask:= D.CommEventMask or EV_TXEMPTY;
  if D.Connected then SetCommMask(D.hComm, D.CommEventMask);
end;


procedure Register;
begin
  RegisterComponents('COMM Seriell', [TComm]);
end;


end.

_________________
Das Leben besteht aus Bits und Bytes - nur: wo laufen sie denn ????
Super ... Du kannst das zwar lesen, toll..... aber: völlig zwecklos !!!
dummzeuch
ontopic starontopic starontopic starontopic starontopic starontopic starhalf ontopic starofftopic star
Beiträge: 593
Erhaltene Danke: 5


Delphi 5 ent, Delphi 6 bis Delphi XE8 pro
BeitragVerfasst: Di 01.01.08 16:59 
Hi,

user profile iconwulfskin hat folgendes geschrieben:
ich habe jetzt schon zwei Komponenten ausprobiert (TComPort und TSerialPortNG), doch bei jedem Schreiben stürzt mein komplettes Betriebsystem mit Bluescreen ab (Fehlermeldung kann ich nicht lesen) (Win XP).
Lesen funktioniert soweit und auch das Schreiben geht mit Putty.

Hier ein Auszug aus der Senderoutine:
ausblenden Delphi-Quelltext
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
WriteFile(hCommPort,
                Data^,
                Size,
                fWrittenBytes,
                @WriteOverlapped)

//weiter oben      
hCommPort := CreateFile(StrPCopy(CommPortName,'\\.\'+Copy(fCommPort,1,79)),
            GENERIC_READ OR GENERIC_WRITE,
            0,
            nil,
            OPEN_EXISTING,
            FILE_FLAG_OVERLAPPED,0);
Er schreibt wohl irgendwo hin, nur nicht dahin wo er soll. Zum Beispiel war nach einem Absturz eine Unit mit Nullen überschrieben...

Ich weiß, es ist die Suche nach der Nadel im Heuhaufen, aber vielleicht hat jemand schon ähnliche Erfahrungen gemacht.


Wilde Vermutung: Hast Du das WriteOverlapped Record korrekt initialisiert? Ansonsten sieht naemlich alles korrekt aus.

twm
wulfskin Threadstarter
ontopic starontopic starontopic starontopic starontopic starontopic starontopic starhalf ontopic star
Beiträge: 1349
Erhaltene Danke: 1

Win XP
D5 Pers (SSL), D2005 Pro, C, C#
BeitragVerfasst: Sa 05.01.08 18:30 
Hallo,

vielen Dank für die Antworten. Ich gehe mal einzeln drauf ein:

user profile iconMAlsleben hat folgendes geschrieben:
(...) was sagt denn der BlueScreen aus? Kann man ja so einstellen, das der Rechner nicht gleich neu startet.
Ich weiß nicht, wo man dies einstellen kann.

user profile iconLuckie hat folgendes geschrieben:
Direkte Hardwarezugriffe sind unter NT Systemen nur über einen Treiber möglich. Allerdings sollte ein Programm im User Mode keine Blue Screen auslösen können. Ich gehe mal davon aus, dass du den Treiber falsch ansprichst und er diesen Fehler nicht abfängt. Guck dir noch mal die Dokumenttaion zu den Komponenten an.
Ich benutze keinen direkte Hardwarezugriffe, sondern die API-Funktionen. Ich bin als Administrator angemeldet, ich weiß nicht ob du das mit User Mode meinst.

user profile iconM. Raab hat folgendes geschrieben:
(..)ich habe ebenfalls eine Komponente - die funzt unter WIN XP und VISTA 32 und 64.
Ich habe es jetzt auch anders hinbekommen und es funktioniert soweit. Danke trotzdem!

user profile icondummzeuch hat folgendes geschrieben:
Wilde Vermutung: Hast Du das WriteOverlapped Record korrekt initialisiert? Ansonsten sieht naemlich alles korrekt aus.
Mag sein, aber ich glaube mit Null füllen und Event erstellen sollte reichen, oder?

Viele Dank für eure Hilfe. Ich habe gerade nicht viel Zeit, dem Problem auf den Grund zu gehen. Ich habe alles komplett selber jetzt geschrieben und es geht. Ich melde mich nochmal, wenn ich weiß an was es lag. Die Klasse die ich geschrieben habe ist nicht sehr schön, deswegen würde ich die nur auf Anfrage veröffentlichen.

Gruß Hape!
Timosch
ontopic starontopic starontopic starontopic starontopic starofftopic starofftopic starofftopic star
Beiträge: 1314

Debian Squeeze, Win 7 Prof.
D7 Pers
BeitragVerfasst: Sa 05.01.08 19:46 
user profile iconwulfskin hat folgendes geschrieben:

user profile iconMAlsleben hat folgendes geschrieben:
(...) was sagt denn der BlueScreen aus? Kann man ja so einstellen, das der Rechner nicht gleich neu startet.
Ich weiß nicht, wo man dies einstellen kann.

Systemsteuerung->System->Erweitert->Starten und Wiederherstellen->Häkchen bei "Automatisch neu starten" weg.
So gehts zumindest bei W2k, bei XP sind evtl. die Beschriftungen ein bisschen anders. Müsste aber zu finden sein.

_________________
If liberty means anything at all, it means the right to tell people what they do not want to hear. - George Orwell