Delphi – 第2页 – 蓝天白云

Delphi获取其他进程中状态栏文本的函数

分类：Delphi 阅读 (1,958) No Responses »

9月 252012

Delphi code to get statusbar text from other process

function GetStatusBarText(mHandle: THandle): string;
var
vBuffer: array[0..$1000] of Char;
vSize: Integer;
I: Integer;
vCount: Integer;
vProcessId: DWORD;
vProcess: THandle;
vPointer: Pointer;
vNumberOfBytesRead: Cardinal;
begin
Result := '';
vCount := SendMessage(mHandle, SB_GETPARTS, 0, 0);
if vCount &lt;= 0 then Exit;
GetWindowThreadProcessId(mHandle, @vProcessId);
vProcess := OpenProcess(PROCESS_VM_OPERATION or PROCESS_VM_READ or
    PROCESS_VM_WRITE, False, vProcessId);
vPointer := VirtualAllocEx(vProcess, nil, $1000, MEM_RESERVE or MEM_COMMIT,
    PAGE_READWRITE);
try
    for I := 0 to vCount - 1 do
    begin
      vSize := SendMessage(mHandle, SB_GETTEXT, I, 0) + 1;
      SendMessage(mHandle, SB_GETTEXT, I, Integer(vPointer));
      ReadProcessMemory(vProcess, vPointer, @vBuffer[0],
        vSize, vNumberOfBytesRead);
      Result := Result + #9 + vBuffer;
    end;
    Delete(Result, 1, 1);
finally
    VirtualFreeEx(vProcess, vPointer, 0, MEM_RELEASE);
    CloseHandle(vProcess);
end;
end;

function GetStatusBarText(mHandle: THandle): string;

var

vBuffer: array[0..$1000] of Char;

vSize: Integer;

I: Integer;

vCount: Integer;

vProcessId: DWORD;

vProcess: THandle;

vPointer: Pointer;

vNumberOfBytesRead: Cardinal;

begin

Result := '';

vCount := SendMessage(mHandle, SB_GETPARTS, 0, 0);

if vCount <= 0 then Exit;

GetWindowThreadProcessId(mHandle, @vProcessId);

vProcess := OpenProcess(PROCESS_VM_OPERATION or PROCESS_VM_READ or

PROCESS_VM_WRITE, False, vProcessId);

vPointer := VirtualAllocEx(vProcess, nil, $1000, MEM_RESERVE or MEM_COMMIT,

PAGE_READWRITE);

try

for I := 0 to vCount - 1 do

begin

vSize := SendMessage(mHandle, SB_GETTEXT, I, 0) + 1;

SendMessage(mHandle, SB_GETTEXT, I, Integer(vPointer));

ReadProcessMemory(vProcess, vPointer, @vBuffer[0],

vSize, vNumberOfBytesRead);

Result := Result + #9 + vBuffer;

end;

Delete(Result, 1, 1);

finally

VirtualFreeEx(vProcess, vPointer, 0, MEM_RELEASE);

CloseHandle(vProcess);

end;

在Delphi中实现Javascript的getTime函数

分类：Delphi 阅读 (2,051) No Responses »

9月 112012

JavaScript
getTime（new Date.getTime 方法）
返回指定的 Date 对象自 1970 年 1 月 1 日午夜（通用时间）以来的毫秒数。当比较两个或更多个 Date 对象时，使用此方法表示某一特定时刻。
返回值类型：Number — 一个整数。
Delphi
MilliSecondsBetween(StrToDateTime(‘1970-01-01 08:00:00’), Now);
注意是8点，北京时间

Delphi中获取剪贴板文字内容的代码

分类：Delphi 阅读 (26,278) No Responses »

8月 232012

uses Clipbrd;

procedure TForm1.Button1Click(Sender: TObject);
var
  CbBuf: PChar;
  BufSize: Integer;
  H: THandle;
begin
  if Clipboard.HasFormat(CF_TEXT) then begin
    H := ClipBoard.GetAsHandle(CF_TEXT);
    BufSize := GlobalSize(H);
    GetMem(CbBuf, BufSize);
    BufSize := Clipboard.GetTextBuf(cbBuf, BufSize);
    Edit1.Text := cbBuf;
  end;
end;

uses Clipbrd;

procedure TForm1.Button1Click(Sender: TObject);

var

CbBuf: PChar;

BufSize: Integer;

H: THandle;

begin

if Clipboard.HasFormat(CF_TEXT) then begin

H := ClipBoard.GetAsHandle(CF_TEXT);

BufSize := GlobalSize(H);

GetMem(CbBuf, BufSize);

BufSize := Clipboard.GetTextBuf(cbBuf, BufSize);

Edit1.Text := cbBuf;

end;

Delphi使用windows Api下载文件

分类：Delphi, Internet 阅读 (2,419) No Responses »

8月 022012

Use windows api to download file in delphi

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, WinInet, StdCtrls;

type
TForm1 = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);

private
    { Private declarations }
public
    { Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

function DownloadToString(const Url: string): string;
var
NetHandle: HINTERNET;
UrlHandle: HINTERNET;
Buffer: array[0..1024] of Char;
BytesRead: dWord;
begin
Result := &#039;&#039;;
NetHandle := InternetOpen(&#039;Delphi 5.x&#039;, INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0);

if Assigned(NetHandle) then
begin
    UrlHandle := InternetOpenUrl(NetHandle, PChar(Url), nil, 0, INTERNET_FLAG_RELOAD, 0);

    if Assigned(UrlHandle) then
      { UrlHandle valid? Proceed with download }
    begin
      FillChar(Buffer, SizeOf(Buffer), 0);
      repeat
        Result := Result + Buffer;
        FillChar(Buffer, SizeOf(Buffer), 0);
        InternetReadFile(UrlHandle, @Buffer, SizeOf(Buffer), BytesRead);
      until BytesRead = 0;
      InternetCloseHandle(UrlHandle);
    end
    else
      { UrlHandle is not valid. Raise an exception. }
      raise Exception.CreateFmt(&#039;Cannot open URL %s&#039;, [Url]);

    InternetCloseHandle(NetHandle);
end
else
    { NetHandle is not valid. Raise an exception }
    raise Exception.Create(&#039;Unable to initialize Wininet&#039;);
end;

function DownloadToFile(const Url, LFile: string): Boolean;
var
NetHandle: HINTERNET;
UrlHandle: HINTERNET;
Buffer: array[0..1024] of Char;
BytesRead: dWord;
LFileStream: TFileStream;
begin
Result := False;
NetHandle := InternetOpen(&#039;Delphi 5.x&#039;, INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0);

if Assigned(NetHandle) then
begin
    UrlHandle := InternetOpenUrl(NetHandle, PChar(Url), nil, 0, INTERNET_FLAG_RELOAD, 0);

    if Assigned(UrlHandle) then
      { UrlHandle valid? Proceed with download }
    begin
      LFileStream := TFileStream.Create(LFile, fmCreate);
      FillChar(Buffer, SizeOf(Buffer), 0);
      repeat
//        Result := Result + Buffer;
        FillChar(Buffer, SizeOf(Buffer), 0);
        InternetReadFile(UrlHandle, @Buffer, SizeOf(Buffer), BytesRead);
        LFileStream.Write(Buffer, BytesRead);
      until BytesRead = 0;
      LFileStream.Free;
      InternetCloseHandle(UrlHandle);
    end
    else
      { UrlHandle is not valid. Raise an exception. }
      raise Exception.CreateFmt(&#039;Cannot open URL %s&#039;, [Url]);

    InternetCloseHandle(NetHandle);
end
else
    { NetHandle is not valid. Raise an exception }
    raise Exception.Create(&#039;Unable to initialize Wininet&#039;);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  Memo1.Lines.Text := DownloadToString(&#039;http://www.mailsextractor.com/&#039;)
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  DownloadToFile(&#039;http://www.mailsextractor.com/mailsextractor.exe&#039;, &#039;mailsextractor.exe&#039;);
end;

end.

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

unit Unit1;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, WinInet, StdCtrls;

type

TForm1 = class(TForm)

Button1: TButton;

Memo1: TMemo;

Button2: TButton;

procedure Button1Click(Sender: TObject);

procedure Button2Click(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form1: TForm1;

implementation

{$R *.dfm}

function DownloadToString(const Url: string): string;

var

NetHandle: HINTERNET;

UrlHandle: HINTERNET;

Buffer: array[0..1024] of Char;

BytesRead: dWord;

begin

Result := '';

NetHandle := InternetOpen('Delphi 5.x', INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0);

if Assigned(NetHandle) then

begin

UrlHandle := InternetOpenUrl(NetHandle, PChar(Url), nil, 0, INTERNET_FLAG_RELOAD, 0);

if Assigned(UrlHandle) then

{ UrlHandle valid? Proceed with download }

begin

FillChar(Buffer, SizeOf(Buffer), 0);

repeat

Result := Result + Buffer;

FillChar(Buffer, SizeOf(Buffer), 0);

InternetReadFile(UrlHandle, @Buffer, SizeOf(Buffer), BytesRead);

until BytesRead = 0;

InternetCloseHandle(UrlHandle);

end

else

{ UrlHandle is not valid. Raise an exception. }

raise Exception.CreateFmt('Cannot open URL %s', [Url]);

InternetCloseHandle(NetHandle);

end

else

{ NetHandle is not valid. Raise an exception }

raise Exception.Create('Unable to initialize Wininet');

end;

function DownloadToFile(const Url, LFile: string): Boolean;

var

NetHandle: HINTERNET;

UrlHandle: HINTERNET;

Buffer: array[0..1024] of Char;

BytesRead: dWord;

LFileStream: TFileStream;

begin

Result := False;

NetHandle := InternetOpen('Delphi 5.x', INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0);

if Assigned(NetHandle) then

begin

UrlHandle := InternetOpenUrl(NetHandle, PChar(Url), nil, 0, INTERNET_FLAG_RELOAD, 0);

if Assigned(UrlHandle) then

{ UrlHandle valid? Proceed with download }

begin

LFileStream := TFileStream.Create(LFile, fmCreate);

FillChar(Buffer, SizeOf(Buffer), 0);

repeat

// Result := Result + Buffer;

FillChar(Buffer, SizeOf(Buffer), 0);

InternetReadFile(UrlHandle, @Buffer, SizeOf(Buffer), BytesRead);

LFileStream.Write(Buffer, BytesRead);

until BytesRead = 0;

LFileStream.Free;

InternetCloseHandle(UrlHandle);

end

else

{ UrlHandle is not valid. Raise an exception. }

raise Exception.CreateFmt('Cannot open URL %s', [Url]);

InternetCloseHandle(NetHandle);

end

else

{ NetHandle is not valid. Raise an exception }

raise Exception.Create('Unable to initialize Wininet');

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

Memo1.Lines.Text := DownloadToString('http://www.mailsextractor.com/')

end;

procedure TForm1.Button2Click(Sender: TObject);

begin

DownloadToFile('http://www.mailsextractor.com/mailsextractor.exe', 'mailsextractor.exe');

end;

end.

above is the code

Use Delphi to Get external program's menu and simulate clicking on it

分类：Delphi 阅读 (1,881) No Responses »

7月 102012

unit Unit1;
interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Buttons, ComCtrls;

type
  TForm1 = class(TForm)
    TreeView1: TTreeView;
    BitBtn1: TBitBtn;
    procedure BitBtn1Click(Sender: TObject);
    procedure TreeView1DblClick(Sender: TObject);
  private
    hnotepad: THandle;
    procedure AddChildMenus(pnd:TTreenode;m:hMenu);
  public
  { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.AddChildMenus(pnd:TTreenode;m:hMenu);
VAR
  i,id:integer;
  nd:TTreenode;
  MText : ARRAY[0..255] OF Char;
begin
  for i:=0 to GetMenuItemCount(m)-1 do begin
  Id := Integer(GetMenuItemID(m, i));
  GetMenuString(m, i, MText, 255, MF_BYPOSITION);
  if id = -1 then begin
  nd:=Treeview1.items.AddChild(pnd, mText);
  AddChildMenus(nd, GetSubMenu(m, i));
  end
  else if length(Trim(MText)) &gt; 0 THEN
  Treeview1.items.AddChildObject(pnd, Format(&#039;%s {ID=%d}&#039;,[MText, Id]), Pointer(Id));
  END;
END;

procedure TForm1.BitBtn1Click(Sender: TObject);
var
  root:TTreenode;
begin
  hnotepad:=FindWindow(nil, &#039;记事本&#039;);
  if hnotepad &lt;&gt; 0 then
    if GetMenu(hnotepad) &lt;&gt; 0 then begin
      root:=Treeview1.items.Add(nil, &#039;Main Menu&#039;);
      AddChildMenus(root, GetMenu(hnotepad));
      Treeview1.FullExpand;
      Refresh;
    end;
end;

procedure TForm1.TreeView1DblClick(Sender: TObject);
begin
  BringWindowToTop(hNotePad);
  PostMessage(hNotePad,WM_COMMAND,Integer(Treeview1.Selected.Data), 0);
end;

end.

unit Unit1;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, StdCtrls, Buttons, ComCtrls;

type

TForm1 = class(TForm)

TreeView1: TTreeView;

BitBtn1: TBitBtn;

procedure BitBtn1Click(Sender: TObject);

procedure TreeView1DblClick(Sender: TObject);

private

hnotepad: THandle;

procedure AddChildMenus(pnd:TTreenode;m:hMenu);

public

{ Public declarations }

end;

var

Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.AddChildMenus(pnd:TTreenode;m:hMenu);

VAR

i,id:integer;

nd:TTreenode;

MText : ARRAY[0..255] OF Char;

begin

for i:=0 to GetMenuItemCount(m)-1 do begin

Id := Integer(GetMenuItemID(m, i));

GetMenuString(m, i, MText, 255, MF_BYPOSITION);

if id = -1 then begin

nd:=Treeview1.items.AddChild(pnd, mText);

AddChildMenus(nd, GetSubMenu(m, i));

end

else if length(Trim(MText)) > 0 THEN

Treeview1.items.AddChildObject(pnd, Format('%s {ID=%d}',[MText, Id]), Pointer(Id));

END;

procedure TForm1.BitBtn1Click(Sender: TObject);

var

root:TTreenode;

begin

hnotepad:=FindWindow(nil, '记事本');

if hnotepad <> 0 then

if GetMenu(hnotepad) <> 0 then begin

root:=Treeview1.items.Add(nil, 'Main Menu');

AddChildMenus(root, GetMenu(hnotepad));

Treeview1.FullExpand;

Refresh;

end;

procedure TForm1.TreeView1DblClick(Sender: TObject);

begin

BringWindowToTop(hNotePad);

PostMessage(hNotePad,WM_COMMAND,Integer(Treeview1.Selected.Data), 0);

end;

end.

Page 2 of 2 Newer Entries 1 2