mirror of
https://github.com/HeidiSQL/HeidiSQL.git
synced 2025-08-06 18:24:26 +08:00
Add Plinkremote unit as a preparation for a better integration of plink.exe into our SSH tunnel.
See * http://www.delphipraxis.net/70989-komponente-fuer-ssh-verbindung-6.html * http://www.heidisql.com/forum.php?t=15206 * issue #2902
This commit is contained in:
Ansgar Becker
@ -41,7 +41,9 @@ uses
|
||||
syncdb in '..\..\source\syncdb.pas' {frmSyncDB},
|
||||
gnugettext in '..\..\source\gnugettext.pas',
|
||||
JumpList in '..\..\source\JumpList.pas',
|
||||
extra_controls in '..\..\source\extra_controls.pas';
|
||||
extra_controls in '..\..\source\extra_controls.pas',
|
||||
Plinkremote in '..\..\source\plinkremote.pas',
|
||||
UPipeThread in '..\..\source\UPipeThread.pas';
|
||||
|
||||
{$R ..\..\res\icon.RES}
|
||||
{$R ..\..\res\version.RES}
|
||||
|
||||
536
source/Plinkremote.pas
Normal file
536
source/Plinkremote.pas
Normal file
@ -0,0 +1,536 @@
|
||||
(************************************************)
|
||||
(*TPlinkremote Version 1.0 (06.06.2006) *)
|
||||
(* *)
|
||||
(*Copyright <20> 2006 by Uwe Zeh *)
|
||||
(*E-Mail: daliuz@gmx.net *)
|
||||
(*- - - - - - - - - - - - - - - - - - - - - - - *)
|
||||
(*Ich <20>bernehme keine Haftung f<>r etwaige *)
|
||||
(*Sch<63>den, die durch diese Komponente verursacht*)
|
||||
(*werden. *)
|
||||
(*- - - - - - - - - - - - - - - - - - - - - - - *)
|
||||
(*Diese Komponente ist FREEWARE. *)
|
||||
(*Alle Rechte vorbehalten *)
|
||||
(* *)
|
||||
(* Vielen Dank an Felix John f<>r die Infos *)
|
||||
(* auf http://www.felix-colibri.com *)
|
||||
(************************************************)
|
||||
unit Plinkremote;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Windows, StrUtils, SysUtils, Classes, Controls, Forms, Dialogs, UPipeThread;
|
||||
|
||||
const
|
||||
LINE_FEED = #10;
|
||||
CARRIAGE_RETURN = #13;
|
||||
NEW_LINE = CARRIAGE_RETURN + LINE_FEED;
|
||||
|
||||
type
|
||||
TTerminateStatus = (tsRunning, tsWaitForTerminate, tsTerminated);
|
||||
|
||||
TPlinkRemote = class; //Class forward
|
||||
TPipe = record
|
||||
ReadHandle: THandle;
|
||||
WriteHandle: THandle;
|
||||
end;
|
||||
|
||||
TExecuteWaitEvent = procedure(
|
||||
const ProcessInfo: TProcessInformation; var ATerminate: Boolean
|
||||
) of object;
|
||||
TPlinkDataAvailableEvent = procedure(
|
||||
Sender: TPlinkRemote; const Buffer: string
|
||||
) of object;
|
||||
TPlinkDataErrorEvent = procedure(
|
||||
Sender: TPlinkRemote; const Buffer: string
|
||||
) of object;
|
||||
TPlinkCloseEvent = procedure(
|
||||
Sender: TPlinkRemote
|
||||
) of object;
|
||||
TPlinkErrorEvent = procedure(
|
||||
Sender: TPlinkRemote; const Error: string
|
||||
) of object;
|
||||
|
||||
TPlinkRemote = class(TComponent)
|
||||
private
|
||||
FTerminate: TTerminateStatus;
|
||||
FInPipe: TPipe;
|
||||
FOutPipe: TPipe;
|
||||
FErrorPipe: TPipe;
|
||||
FFilename: string;
|
||||
FParameters: string;
|
||||
Fm_EscFLag: Boolean;
|
||||
Fm_EscBuffer: string[80];
|
||||
FClearEscSeq: Boolean;
|
||||
FLogFileName: string;
|
||||
FLogging: Boolean;
|
||||
FPipe: TPipeThread;
|
||||
FProcessInfo : TProcessInformation;
|
||||
function IsRunning(create_event: Boolean): Boolean;
|
||||
function CreatePipeEx(var pv_pipe: TPipe): boolean;
|
||||
procedure ClosePipe(p_pipe: TPipe);
|
||||
function CreatePipes: Boolean;
|
||||
procedure ClosePipes;
|
||||
procedure ReadOutput;
|
||||
procedure ReadError;
|
||||
function ReadPipe(const APipe : TPipe) : String;
|
||||
function ASCII2ANSI(AText:AnsiString):AnsiString;
|
||||
procedure ExecuteFile(const AFilename: string; AParameter,
|
||||
ACurrentDir: string; AWait: Boolean);
|
||||
function CleanEscSeq(const buffer: string): string;
|
||||
function f_check_Escapeseq(const chr: char): char;
|
||||
procedure WriteLog(p_text, log_file_name: string);
|
||||
function IsTrustedKey(const Buffer: String): Boolean;
|
||||
function GetExecuted: Boolean;
|
||||
procedure PipeReadPipeData;
|
||||
protected
|
||||
FOnDataAvailable: TPlinkDataAvailableEvent;
|
||||
FOnDataError: TPlinkDataErrorEvent;
|
||||
FOnPlinkclose: TPlinkCloseEvent;
|
||||
FOnError: TPlinkErrorEvent;
|
||||
public
|
||||
destructor Destroy; override;
|
||||
constructor Create(AOwner: TComponent); override;
|
||||
published
|
||||
function Execute : Boolean;
|
||||
procedure Terminate;
|
||||
procedure SendText(AText : String);
|
||||
property OnDataError: TPlinkDataErrorEvent
|
||||
read FOnDataError write FOnDataError;
|
||||
property OnDataAvailable: TPlinkDataAvailableEvent
|
||||
read FOnDataAvailable write FOnDataAvailable;
|
||||
property OnPlinkClose: TPlinkCloseEvent
|
||||
read FOnPlinkclose write FOnPlinkclose;
|
||||
property OnError: TPlinkErrorEvent
|
||||
read FOnError write FOnError;
|
||||
property Filename: string
|
||||
read FFilename write FFilename;
|
||||
property Parameters: string
|
||||
read FParameters write FParameters;
|
||||
property ClearEsqSeq: Boolean
|
||||
read FClearEscSeq write FClearEscSeq default false;
|
||||
property LogFileName: string
|
||||
read FLogFileName write FLogFileName;
|
||||
property LogFile: Boolean
|
||||
read FLogging write FLogging default false;
|
||||
property Executed : Boolean
|
||||
read GetExecuted;
|
||||
end;
|
||||
|
||||
{procedure Register;}
|
||||
|
||||
implementation
|
||||
|
||||
function TPlinkRemote.CreatePipeEx(var pv_pipe: TPipe): boolean;
|
||||
const
|
||||
k_pipe_buffer_size = 8192;
|
||||
begin
|
||||
with pv_pipe do
|
||||
begin
|
||||
// -- Create the pipe
|
||||
result:= CreatePipe(ReadHandle, WriteHandle, nil, k_pipe_buffer_size);
|
||||
|
||||
if result then
|
||||
result:= DuplicateHandle(
|
||||
GetCurrentProcess, ReadHandle,
|
||||
GetCurrentProcess, @ReadHandle, 0, True,
|
||||
DUPLICATE_CLOSE_SOURCE OR DUPLICATE_SAME_ACCESS
|
||||
);
|
||||
|
||||
if result then result:= DuplicateHandle(
|
||||
GetCurrentProcess, WriteHandle,
|
||||
GetCurrentProcess, @WriteHandle, 0, True,
|
||||
DUPLICATE_CLOSE_SOURCE OR DUPLICATE_SAME_ACCESS
|
||||
);
|
||||
end;
|
||||
end; // CreatePipeEx
|
||||
|
||||
procedure TPlinkRemote.ClosePipe(p_pipe: TPipe);
|
||||
begin
|
||||
with p_pipe do
|
||||
begin
|
||||
CloseHandle(ReadHandle);
|
||||
CloseHandle(WriteHandle);
|
||||
end;
|
||||
end; // ClosePipe
|
||||
|
||||
function TPlinkRemote.CreatePipes: Boolean;
|
||||
begin
|
||||
Result:= CreatePipeEx(FInPipe)
|
||||
and CreatePipeEx(FOutPipe)
|
||||
and CreatePipeEx(FErrorPipe);
|
||||
end; // CreatePipes
|
||||
|
||||
procedure TPlinkRemote.ClosePipes;
|
||||
begin
|
||||
ClosePipe(FInPipe);
|
||||
ClosePipe(FOutPipe);
|
||||
ClosePipe(FErrorPipe);
|
||||
end; // ClosePipes
|
||||
|
||||
procedure TPlinkRemote.ExecuteFile(const AFilename: string; AParameter,
|
||||
ACurrentDir: string; AWait: Boolean);
|
||||
var
|
||||
StartupInfo: TStartupInfo;
|
||||
FileDirectory: pchar;
|
||||
begin
|
||||
if not CreatePipes then
|
||||
begin
|
||||
if Assigned(OnError) then
|
||||
OnError(Self, 'Error creating I/O pipes!');
|
||||
end
|
||||
else begin
|
||||
if (ACurrentDir <> '') and (AnsiLastChar(ACurrentDir) = '\') then
|
||||
Delete(ACurrentDir, Length(ACurrentDir), 1);
|
||||
if ACurrentDir = '' then
|
||||
FileDirectory := nil
|
||||
else
|
||||
FileDirectory := PChar(ACurrentDir);
|
||||
|
||||
FillChar(StartupInfo, SizeOf(StartupInfo), 0);
|
||||
with StartupInfo do begin
|
||||
cb := SizeOf(StartupInfo);
|
||||
dwFlags := STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES;
|
||||
wShowWindow := SW_HIDE; // show no window
|
||||
hStdInput:= FInPipe.ReadHandle; // read input from input pipe
|
||||
hStdError:= FErrorPipe.WriteHandle; // Write errors to the error pipe
|
||||
hStdOutput:= FOutPipe.WriteHandle; // Write Ouput to output pipe
|
||||
end;
|
||||
|
||||
FillChar(FProcessInfo, SizeOf(FProcessInfo), 0);
|
||||
AParameter := Format('%s %s', [AFilename, TrimRight(AParameter)]);
|
||||
|
||||
if FTerminate = tsTerminated then
|
||||
begin
|
||||
if CreateProcess(
|
||||
nil, PChar(AParameter), nil, nil, true,
|
||||
CREATE_DEFAULT_ERROR_MODE or CREATE_NEW_CONSOLE or NORMAL_PRIORITY_CLASS,
|
||||
nil, FileDirectory, StartupInfo, FProcessInfo) then
|
||||
begin
|
||||
FPipe.ProcessHandle := FProcessInfo.hProcess;
|
||||
FTerminate := tsRunning;
|
||||
FPipe.Resume;
|
||||
end;
|
||||
end else
|
||||
begin
|
||||
if Assigned(OnError) then
|
||||
OnError(Self, 'Prozess "'+AFilename+'" konnte nicht gestartet werden!');
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TPlinkRemote.ReadOutput;
|
||||
var
|
||||
Output : string;
|
||||
begin
|
||||
Output := ReadPipe(FOutPipe);
|
||||
if Output <> '' then
|
||||
begin
|
||||
if Assigned(FOnDataAvailable) then
|
||||
FOnDataAvailable(Self, Output);
|
||||
end; // received some bytes
|
||||
end;
|
||||
|
||||
function TPlinkRemote.ASCII2ANSI(AText:AnsiString):AnsiString;
|
||||
const cMaxLength = 255;
|
||||
var PText : PAnsiChar;
|
||||
begin
|
||||
Result:='';
|
||||
PText:=AnsiStrAlloc(cMaxLength);
|
||||
while AText <> '' do begin
|
||||
StrPCopy(PText, copy(AText, 1, cMaxLength-1));
|
||||
OemToAnsi(PText, PText);
|
||||
Result:=Result + StrPas(PText);
|
||||
delete(AText, 1, cMaxLength-1);
|
||||
end;
|
||||
StrDispose(PText);
|
||||
end;
|
||||
|
||||
function TPlinkRemote.ReadPipe(const APipe: TPipe): String;
|
||||
var
|
||||
BufferReadCount, OutLen: Cardinal;
|
||||
BytesRemaining : Cardinal;
|
||||
Buffer : array [0..1023] of AnsiChar;
|
||||
R:AnsiString;
|
||||
begin
|
||||
Result := '';
|
||||
if APipe.ReadHandle = INVALID_HANDLE_VALUE then
|
||||
begin
|
||||
if Assigned(OnError) then
|
||||
OnError(Self, 'Error I/O pipes!');
|
||||
end
|
||||
else begin
|
||||
// -- check to see if there is any data to read from stdout
|
||||
PeekNamedPipe(
|
||||
APipe.ReadHandle, nil, 0, nil, @BufferReadCount, nil
|
||||
);
|
||||
|
||||
if BufferReadCount <> 0 then
|
||||
begin
|
||||
FillChar(Buffer, sizeof(Buffer), 'z');
|
||||
// -- read by 1024 bytes chunks
|
||||
BytesRemaining := BufferReadCount;
|
||||
OutLen := 0;
|
||||
while BytesRemaining >= 1024 do
|
||||
begin
|
||||
// -- read the stdout pipe
|
||||
ReadFile(APipe.ReadHandle, Buffer, 1024, BufferReadCount, nil);
|
||||
Dec(BytesRemaining, BufferReadCount);
|
||||
|
||||
SetLength(R, OutLen + BufferReadCount);
|
||||
Move(Buffer, R[OutLen + 1], BufferReadCount);
|
||||
Inc(OutLen, BufferReadCount);
|
||||
end;
|
||||
|
||||
if BytesRemaining > 0 then
|
||||
begin
|
||||
ReadFile(APipe.ReadHandle, Buffer, BytesRemaining, BufferReadCount, nil);
|
||||
SetLength(R, OutLen + BufferReadCount);
|
||||
Move(Buffer, R[OutLen + 1], BufferReadCount);
|
||||
end;
|
||||
|
||||
R:=ASCII2ANSI(R);
|
||||
{$WARNINGS OFF}
|
||||
Result:=AnsiToUtf8(R);
|
||||
{$WARNINGS ON}
|
||||
|
||||
if FClearEscSeq then
|
||||
Result := CleanEscSeq(Result);
|
||||
if FLogging then
|
||||
WriteLog(Result, FLogFileName);
|
||||
end; // received some bytes
|
||||
end;
|
||||
Result:=StringReplace(
|
||||
Result,
|
||||
CARRIAGE_RETURN + CARRIAGE_RETURN + LINE_FEED, CARRIAGE_RETURN + LINE_FEED,
|
||||
[rfReplaceAll]
|
||||
);
|
||||
end;
|
||||
|
||||
// ReadOutput
|
||||
|
||||
procedure TPlinkRemote.ReadError;
|
||||
var
|
||||
Output : String;
|
||||
begin
|
||||
Output := ReadPipe(FErrorPipe);
|
||||
if Output <> '' then
|
||||
begin
|
||||
if not IsTrustedKey(Output) and Assigned(OnDataError) then
|
||||
OnDataError(Self, Output);
|
||||
end;
|
||||
end; // ReadError
|
||||
|
||||
procedure TPlinkRemote.SendText(AText: String);
|
||||
var
|
||||
WrittenBytes: Cardinal;
|
||||
Text:AnsiString;
|
||||
begin
|
||||
// -- check if the process is still active
|
||||
if IsRunning(true) then
|
||||
begin
|
||||
{$WARNINGS OFF}
|
||||
Text:=Utf8ToAnsi(AText);
|
||||
{$WARNINGS ON}
|
||||
if Text <> '' then
|
||||
WriteFile(FInPipe.WriteHandle, Text[1], Length(Text), WrittenBytes, nil);
|
||||
end;
|
||||
end; // SendText
|
||||
|
||||
function TPlinkRemote.Execute: boolean;
|
||||
begin
|
||||
// -- check if the process is still active
|
||||
Result := false;
|
||||
if (FTerminate = tsTerminated) and not IsRunning(false) then
|
||||
begin
|
||||
if not FileExists(Filename)then
|
||||
begin
|
||||
if Assigned(OnError) then
|
||||
OnError(Self, 'Datei nicht gefunden: ' + Filename);
|
||||
end
|
||||
else begin
|
||||
// --start program
|
||||
ExecuteFile(Filename, FParameters, ExtractFileDir(Filename), True);
|
||||
Result := true;
|
||||
end;
|
||||
end
|
||||
else if Assigned(OnError) then
|
||||
OnError(Self, 'Prozess: ' + FFilename + ' bereits gestartet!!');
|
||||
end;
|
||||
|
||||
procedure TPlinkRemote.Terminate;
|
||||
begin
|
||||
if FTerminate <> tsTerminated then
|
||||
FTerminate := tsWaitForTerminate;
|
||||
end;
|
||||
|
||||
destructor TPlinkRemote.Destroy;
|
||||
begin
|
||||
// Initiere ein Beenden des Programms
|
||||
if FTerminate <> tsTerminated then
|
||||
begin
|
||||
Terminate;
|
||||
PipeReadPipeData;
|
||||
end;
|
||||
FPipe.Terminate;
|
||||
Application.ProcessMessages;
|
||||
if FPipe.Suspended then
|
||||
FPipe.Resume;
|
||||
Application.ProcessMessages;
|
||||
FPipe.Free;
|
||||
inherited;
|
||||
end;
|
||||
|
||||
constructor TPlinkRemote.Create(AOwner: Tcomponent);
|
||||
begin
|
||||
inherited Create(AOwner);
|
||||
FPipe := TPipeThread.Create(true);
|
||||
FPipe.ReadPipeData := PipeReadPipeData;
|
||||
FTerminate := tsTerminated;
|
||||
FOnDataAvailable:=nil;
|
||||
FOnDataError:=nil;
|
||||
FOnPlinkclose:=nil;
|
||||
FOnError:=nil;
|
||||
end;
|
||||
|
||||
function TPlinkRemote.CleanEscSeq(const buffer: string): string;
|
||||
var i : integer;
|
||||
chr: char;
|
||||
begin
|
||||
result:='';
|
||||
Fm_EscFlag := FALSE;
|
||||
for I := 1 to Length(Buffer) do
|
||||
begin
|
||||
chr:= f_check_Escapeseq(buffer[I]);
|
||||
if chr <> #0 then
|
||||
result:=result + chr;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TPlinkRemote.f_check_Escapeseq(const chr: char): char;
|
||||
var
|
||||
bProcess : Boolean;
|
||||
begin
|
||||
Result := #0;
|
||||
if Fm_EscFLag then
|
||||
begin
|
||||
bProcess := False;
|
||||
if (Length(Fm_EscBuffer) = 0)
|
||||
and CharInSet(Chr, ['D', 'M', 'E', 'H', '7', '8', '=', '>', '<']) then
|
||||
begin
|
||||
bProcess := True;
|
||||
end
|
||||
else if (Length(Fm_EscBuffer) = 1)
|
||||
and (Fm_EscBuffer[1] in ['(', ')', '*', '+']) then
|
||||
begin
|
||||
bProcess := True;
|
||||
end
|
||||
else if CharInSet(Chr, ['0'..'9', ';', '?', ' '])
|
||||
or ( (Length(Fm_EscBuffer) = 0)
|
||||
and CharInSet(chr, ['[', '(', ')', '*', '+'])) then
|
||||
begin
|
||||
{$WARNINGS OFF}
|
||||
Fm_EscBuffer := Fm_EscBuffer + Chr;
|
||||
{$WARNINGS ON}
|
||||
if Length(Fm_EscBuffer) >= High(Fm_EscBuffer) then
|
||||
begin
|
||||
MessageBeep(MB_ICONASTERISK);
|
||||
Fm_EscBuffer := '';
|
||||
Fm_EscFlag := FALSE;
|
||||
end;
|
||||
end
|
||||
else
|
||||
bProcess := True;
|
||||
|
||||
if bProcess then
|
||||
begin
|
||||
Fm_EscBuffer := '';
|
||||
Fm_EscFlag := FALSE;
|
||||
end;
|
||||
end
|
||||
else if chr = #27 then
|
||||
begin
|
||||
Fm_EscBuffer := '';
|
||||
Fm_EscFlag := TRUE;
|
||||
end
|
||||
else
|
||||
result:= chr;
|
||||
end;
|
||||
|
||||
procedure TPlinkRemote.WriteLog(p_text: string; log_file_name: string);
|
||||
var log_file: file;
|
||||
begin
|
||||
AssignFile(log_file,log_file_name);
|
||||
if not FileExists(log_file_name)then
|
||||
Rewrite(log_file, 1)
|
||||
else
|
||||
reset(log_file, 1);
|
||||
Seek(log_file, FileSize(log_file));
|
||||
BlockWrite(log_file, p_text[1], Length(p_text));
|
||||
Close(log_file);
|
||||
end; // write_string
|
||||
|
||||
function TPlinkRemote.IsRunning(create_event: Boolean): Boolean;
|
||||
var
|
||||
l_process_exit_code: Cardinal;
|
||||
begin
|
||||
Result := false;
|
||||
// -- check if the process is still active
|
||||
GetExitCodeProcess(FProcessInfo.hProcess, l_process_exit_code);
|
||||
if l_process_exit_code = STILL_ACTIVE then
|
||||
result:= true;
|
||||
if not result and create_event and Assigned(OnPlinkClose) then
|
||||
OnPlinkClose(Self);
|
||||
end;
|
||||
|
||||
procedure Register;
|
||||
begin
|
||||
RegisterComponents('PuttyComp', [TPlinkRemote]);
|
||||
end;
|
||||
|
||||
function TPlinkRemote.IsTrustedKey(const Buffer: String): Boolean;
|
||||
begin
|
||||
result:= false;
|
||||
if Pos('host key is not cached in the registry', buffer) > 0 then
|
||||
begin
|
||||
result:= true;
|
||||
if MessageDlg(Buffer, mtInformation, [mbYes, mbNo], 0) = mrYes then
|
||||
SendText('y')
|
||||
else
|
||||
SendText('n');
|
||||
end;
|
||||
if Pos('host key does not match the one PuTTY', buffer) > 0 then
|
||||
begin
|
||||
result:= true;
|
||||
if MessageDlg(Buffer, mtError, [mbYes, mbNo], 0) = mrYes then
|
||||
SendText('y')
|
||||
else
|
||||
SendText('n');
|
||||
end;
|
||||
end;
|
||||
|
||||
function TPlinkRemote.GetExecuted: Boolean;
|
||||
begin
|
||||
Result := IsRunning(false);
|
||||
end;
|
||||
|
||||
procedure TPlinkRemote.PipeReadPipeData;
|
||||
begin
|
||||
if FTerminate <> tsTerminated then
|
||||
begin
|
||||
ReadOutput;
|
||||
ReadError;
|
||||
if FTerminate = tsWaitForTerminate then
|
||||
begin
|
||||
FPipe.WillSuspend := true;
|
||||
TerminateProcess(FProcessInfo.hProcess, 0); //Cardinal(-1));
|
||||
CloseHandle(FProcessInfo.hProcess); // close programm
|
||||
CloseHandle(FProcessInfo.hThread);
|
||||
ClosePipes; // close all pipes
|
||||
FTerminate := tsTerminated;
|
||||
IsRunning(true); // create a on closeevent
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
end.
|
||||
63
source/UPipeThread.pas
Normal file
63
source/UPipeThread.pas
Normal file
@ -0,0 +1,63 @@
|
||||
unit UPipeThread;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Windows, Classes;
|
||||
|
||||
type
|
||||
TPipeThread = class(TThread)
|
||||
private
|
||||
FReadPipeData: TThreadMethod;
|
||||
FProcessHandle: THandle;
|
||||
FWillSuspend : Boolean;
|
||||
protected
|
||||
procedure Execute; override;
|
||||
public
|
||||
procedure Resume; reintroduce;
|
||||
property ProcessHandle : THandle
|
||||
read FProcessHandle write FProcessHandle;
|
||||
property ReadPipeData: TThreadMethod
|
||||
read FReadPipeData write FReadPipeData;
|
||||
property WillSuspend : Boolean
|
||||
read FWillSuspend write FWillSuspend;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
{ Wichtig: Methoden und Eigenschaften von Objekten in visuellen Komponenten d<>rfen
|
||||
nur in einer Methode namens Synchronize aufgerufen werden, z.B.
|
||||
|
||||
Synchronize(UpdateCaption);
|
||||
|
||||
und UpdateCaption k<>nnte folgenderma<6D>en aussehen:
|
||||
|
||||
procedure TPipeThread.UpdateCaption;
|
||||
begin
|
||||
Form1.Caption := 'Aktualisiert in einem Thread';
|
||||
end; }
|
||||
|
||||
{ TPipeThread }
|
||||
|
||||
procedure TPipeThread.Execute;
|
||||
begin
|
||||
FWillSuspend := false;
|
||||
while (WaitForSingleObject(ProcessHandle,1) <> WAIT_OBJECT_0)
|
||||
and not Terminated do
|
||||
begin
|
||||
if Assigned(FReadPipeData) then
|
||||
Synchronize(FReadPipeData);
|
||||
if FWillSuspend then
|
||||
Suspend
|
||||
else
|
||||
Sleep(1);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TPipeThread.Resume;
|
||||
begin
|
||||
FWillSuspend := false;
|
||||
inherited;
|
||||
end;
|
||||
|
||||
end.
|
||||
Reference in New Issue
Block a user