Delphi – 第5页 – 蓝天白云

Delphi使用windows Api下载文件

分类：Delphi, Internet 阅读 (2,410) 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

unable to load cvstools错误

分类：Other 阅读 (1,579) No Responses »

8月 022012

今天在虚拟机中使用CVS CheckOut的时候出现了”Unable to
load MSVCP711.dll (0x0000007e). Check application installation”.的错误，后来在网上查了查，可能是缺少msvcp71.dll的原因，下载了一个msvcp71.dll到X:Program FilesCommon FilesMarch Hare Software Ltd目录后，问题就解决了。

Show category navbar under menu navigation in WordPress

分类：Other 阅读 (1,655) No Responses »

7月 112012

WordPress Ver: 3.4.1
Theme: suffusion version 4.2.5

A screen shot of where is the category navbar

Steps to configure the option

1. Sign in your wordpress back-end
2. Select page Appearance->Suffusion Options on the left function navigation bar
3. Select “Other Graphical Elements” on the top of suffusion options page

4. Select “Breadcrumbs and Page Navigation” on the left bar

5. And now you can configure the category text navigation bar in the page now.

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

分类：Delphi 阅读 (1,872) 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 5 of 5 Newer Entries 1 2 3 4 5