Jump to content

HolgerX

Members
  • Content Count

    18
  • Joined

  • Last visited

Community Reputation

6 Neutral

Technical Information

  • Delphi-Version
    Delphi 2 - 7

Recent Profile Visitors

The recent visitors block is disabled and is not being shown to other users.

  1. HolgerX

    Running commandline app and capturing output

    Hmm.. I have a code here that uses pipes instead of tmp files for the output: function GetConsoleOutput2(const Command : WideString; Output, Errors : TStrings) : Boolean; var Buffer : array[0..2400] of AnsiChar; BufferStrOutput : AnsiString; BufferStrErrors : AnsiString; CreationFlags : DWORD; NumberOfBytesRead : DWORD; PipeErrorsRead : THandle; PipeErrorsWrite : THandle; PipeOutputRead : THandle; PipeOutputWrite : THandle; ProcessInfo : TProcessInformation; SecurityAttr : TSecurityAttributes; StartupInfo : TStartupInfo; tmpWaitR : DWORD; procedure AddLine(var AString : string; ALines : TStrings); var i : integer; begin i := pos(#13#10, AString); while i > 0 do begin ALines.Add(copy(AString,1,i-1)); Delete(AString,1,i+1); i := pos(#13#10, AString); end; end; begin //Initialisierung ProcessInfo FillChar(ProcessInfo, SizeOf(TProcessInformation), 0); //Initialisierung SecurityAttr FillChar(SecurityAttr, SizeOf(TSecurityAttributes), 0); SecurityAttr.nLength := SizeOf(TSecurityAttributes); SecurityAttr.bInheritHandle := True; SecurityAttr.lpSecurityDescriptor := nil; //Pipes erzeugen CreatePipe(PipeOutputRead, PipeOutputWrite, @SecurityAttr, 0); CreatePipe(PipeErrorsRead, PipeErrorsWrite, @SecurityAttr, 0); //Initialisierung StartupInfo FillChar(StartupInfo, SizeOf(TStartupInfo), 0); StartupInfo.cb := SizeOf(TStartupInfo); StartupInfo.hStdInput := 0; StartupInfo.hStdOutput := PipeOutputWrite; StartupInfo.hStdError := PipeErrorsWrite; StartupInfo.wShowWindow := SW_HIDE; StartupInfo.dwFlags := STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES; CreationFlags := CREATE_DEFAULT_ERROR_MODE or CREATE_NEW_CONSOLE or NORMAL_PRIORITY_CLASS; result := CreateProcessW(nil, (PWideChar(Command)), nil, nil, True, CreationFlags, nil, nil, StartupInfo, ProcessInfo); if result then begin //Write-Pipes schließen CloseHandle(PipeOutputWrite); CloseHandle(PipeErrorsWrite); BufferStrOutput := ''; BufferStrErrors := ''; repeat tmpWaitR := WaitForSingleObject(ProcessInfo.hProcess, 100); NumberOfBytesRead := 0; //Ausgabe Read-Pipe auslesen if PeekNamedPipe(PipeOutputRead, nil, 0, nil, @NumberOfBytesRead, nil) and (NumberOfBytesRead > 0) then begin while ReadFile(PipeOutputRead, Buffer, Length(Buffer)-1, NumberOfBytesRead, nil) do begin Buffer[NumberOfBytesRead] := #0; OemToAnsi(Buffer, Buffer); BufferStrOutput := BufferStrOutput + Buffer; AddLine(BufferStrOutput,Output); Application.ProcessMessages(); end; end; NumberOfBytesRead := 0; if PeekNamedPipe(PipeErrorsRead, nil, 0, nil, @NumberOfBytesRead, nil) and (NumberOfBytesRead > 0) then begin while ReadFile(PipeErrorsRead, Buffer, Length(Buffer)-1, NumberOfBytesRead, nil) do begin Buffer[NumberOfBytesRead] := #0; OemToAnsi(Buffer, Buffer); BufferStrErrors := BufferStrErrors + Buffer; AddLine(BufferStrErrors,Errors); Application.ProcessMessages(); end; end; Application.ProcessMessages(); until (tmpWaitR <> WAIT_TIMEOUT); if BufferStrOutput <> '' then Output.Add(BufferStrOutput); if BufferStrErrors <> '' then Errors.Add(BufferStrErrors); CloseHandle(ProcessInfo.hProcess); CloseHandle(ProcessInfo.hThread); CloseHandle(PipeOutputRead); CloseHandle(PipeErrorsRead); end else begin //Pipes schließen CloseHandle(PipeOutputRead); CloseHandle(PipeOutputWrite); CloseHandle(PipeErrorsRead); CloseHandle(PipeErrorsWrite); end; end; Keep in mind that some DOS commands only work within the CMD or give a return. So just put 'cmd.exe /A /C' before you actually call it. The Application.ProcessMessages(); are only needed when you ausing Memos for Output, Errors...
  2. HolgerX

    Delphi 2007 supported in Indy 10?

    Sorry to read this .. Especially old projects, which cannot be upgraded to a new Delphi version, will probably have to stop at INDY 10 ..
  3. HolgerX

    How to make app with tabbed set of VNC windows

    hmm I played with TightVNC as a test. Get the window handle (FindwindowW (..)) from the VNC and then used the following: var VNCHandle : HWND; .. VNCHandle := FindwindowW(nil, PWideChar(WindowCaption)); if VNCHandle <> 0 then begin Windows.SetParent(VNCHandle,Panel1.Handle); WPM.Length:=SizeOf(WPM); GetWindowPlacement(VNCHandle,@WPM); Rect.Top :=0; Rect.Left :=0; Rect.Right :=Panel1.Width; Rect.Bottom:=Panel1.Height; wpm.rcNormalPosition:=Rect; SetWindowPlacement(VNCHandle,@WPM); end; This shows the VNC window in the panel. Do this several times, each with its own panel and you can then manipulate the panels with the VNC windows as you like.
  4. HolgerX

    WinInet coding for Windows XP

    Hmm.. Or if you only need TLS 1.2 INDY should an option. With the OpenSSL Libs Up to TLS 1.2 could be used insteed of the libs from the OS. This should than run with WinXP.
  5. HolgerX

    [Macos, APFS, VmWare] Shrinking VM images

    Hmm.. Unfortunately, this was not possible with a simple script. I had a simple tool written, which after defrag (with move to the beginning!) Just new files (each 40 MB size) with always # 0 as a character has generated. Thus I filled the 'empty' area of the hard disk completely with # 0. Finally, just delete these files again. Was just a workarround for VirtualPC .. With the DiskManager of VirtualPC, the physical size of the hard disk could be reduced. Do you already know this link? https://virtualman.wordpress.com/2016/02/24/shrink-a-vmware-virtual-machine-disk-vmdk/ This was linked from https://communities.vmware.com/thread/572240 (Translated from german with Goolge 😉 )
  6. HolgerX

    [Macos, APFS, VmWare] Shrinking VM images

    Hmm.. With VirtualPC (Microsoft..) it was necessary, after defragmenting, to overwrite the now 'free' space with e.g. '0', only then had its dynamic reduction works. Maybe 'thinks' VMWare that even in the actually empty areas are still data?
  7. Right, I just wanted to give the declaration as a hint. 😉
  8. Hmm.. and starting with W7 you have to use the function PowerCreateRequest(REASON_CONTEXT: TREASON_CONTEXT): THandle; stdcall; external 'kernel32.dll' name 'PowerCreateRequest'; function PowerSetRequest(PowerRequestHandle: THandle; PowerRequestType : TPowerRequestType): BOOL; stdcall; external 'kernel32.dll' name 'PowerSetRequest'; function PowerClearRequest(PowerRequestHandle: THandle; PowerRequestType : TPowerRequestType): BOOL; stdcall; external 'kernel32.dll' name 'PowerClearRequest';
  9. HolgerX

    UDP multicast issues

    Hmm.. I am not using ICS, but I have a small testtool for MultiCast made with INDY 10. It's done with D6, but you could use it for a local test... (Indy 10 is only in the search path, not added to the zip.. 😉 ) Test_INDY_Multicast.zip
  10. Hmm.. I came with this some posts ago, but I think you didn't need overload when you use 'reintroduce'..
  11. Hmm.. I thing 'override' is wrong, 'reintroduce' have to use! The declaration is different.
  12. HolgerX

    PDF Encryption

    Hmm.. Take a look to ghostscript: https://stackoverflow.com/questions/12921006/password-protected-pdf-using-ghostscript/12929181
  13. Hmm.. Who 'is Active'? I login nearly every day, read nearly every changed thread.. But, of course, I only answer, if I have something to write... And this is actualy nearly nothing... Are I am an active User (reading) or not, of course I write nearly nothing? 😉
  14. HolgerX

    Feature request: "Show in Explorer"

    Hmm.. I use SHOpenFolderAndSelectItems with ILCreateFromPath to open Explorer and select a file in a new Explorer window: unit USelectFileE; interface function OpenFolderAndSelectFile(const FileName: string): boolean; implementation uses Windows, ShellAPI, ShlObj; const OFASI_EDIT = $0001; OFASI_OPENDESKTOP = $0002; {$IFDEF UNICODE} function ILCreateFromPath(pszPath: PChar): PItemIDList stdcall; external shell32 name 'ILCreateFromPathW'; {$ELSE} function ILCreateFromPath(pszPath: PChar): PItemIDList stdcall; external shell32 name 'ILCreateFromPathA'; {$ENDIF} procedure ILFree(pidl: PItemIDList) stdcall; external shell32; function SHOpenFolderAndSelectItems(pidlFolder: PItemIDList; cidl: Cardinal; apidl: pointer; dwFlags: DWORD): HRESULT; stdcall; external shell32; function OpenFolderAndSelectFile(const FileName: string): boolean; var IIDL: PItemIDList; begin result := false; IIDL := ILCreateFromPath(PChar(FileName)); if IIDL <> nil then try result := SHOpenFolderAndSelectItems(IIDL, 0, nil, 0) = S_OK; finally ILFree(IIDL); end; end; end.
  15. HolgerX

    ShlObj -> PickIconDlg() - strange behaviour

    Hmm.. the buffer for pszIconPath 'must' be have the size of MAX_PATH.. https://docs.microsoft.com/en-us/windows/desktop/api/shlobj_core/nf-shlobj_core-pickicondlg function PickIconDlg(AHwnd : HWND; pszIconPath : PWideString; cchIconPath : DWORD; var piIconIndex : integer):integer; stdcall; external 'Shell32.dll' name 'PickIconDlg'; function PickIconDialog(var Filename: WideString; var IconIndex: Integer ): Boolean; var tmp : Array[0..MAX_PATH-1] of WideChar; // Min Size of pszIconPath must be MAX_PATH begin Result := False; FillChar(tmp[0], MAX_PATH * SizeOf(WideChar),0); Move(FileName[1],tmp[0],Length(FileName)* SizeOf(WideChar)); if ( PickIconDlg( 0, @tmp[0], MAX_PATH, IconIndex ) <> 0 ) then begin Filename := Widestring(tmp); Result := True; end; end; procedure TForm1.Button1Click(Sender: TObject); var tmpIdx : integer; tmpFile : WideString; begin tmpFile := ParamStr(0); PickIconDialog(tmpFile, tmpIdx); ShowMessage(tmpFile + ' - ' + IntToStr(tmpIdx)); end;
×