Internet – 蓝天白云

Delphi中使用TIdhttp模拟发送cookie

分类：Internet 阅读 (3,449) No Responses »

10月 292012

Cookie是网站存在用户本地的一些变量，用于保存一些数据以识别用户的身份或者记录用户偏好设置等。
使用smartsniff等网络截包工具查看，当执行请求时实际上是在http请求数据里加入了cookie: key1=value1; key2=value2 …这样的值，返回数据时是类似set-cookie: key1=value1这样的值。
因为我们完全可以在用TIdHttp执行网络请求的时候模拟自己的cookie值并发送到服务器端。
这里要先说明一些TIdhttp的一个属性，AllowCookies，当此值为False时允许用户发送自定义的cookie，当此值为True时，不允许用户发送自定义的cookie。
下面是一段代码：

uses StrUtils;

procedure TForm1.Button1Click(Sender: TObject);
var
  J: Integer;
  HtmlStr: string;
begin
  // 此循环用于删除原来有的cookie值
  for J := IdHTTP1.Request.CustomHeaders.Count - 1 downto 0 do begin
    if StartsText('cookie:', IdHTTP1.Request.CustomHeaders[J]) then
      IdHTTP1.Request.CustomHeaders.Delete(J);
  end;
  IdHTTP1.Request.CustomHeaders.Add('Cookie: username=bcoder' ) ;
  // 另还可用下面的方法实现，没实验过
  //IdHTTP1.Request.CustomHeaders.Values['cookie'] := 'username=bcoder';
  HtmlStr := IdHTTP1.Get('http://svn1.bcoder.com');
end;

uses StrUtils;

procedure TForm1.Button1Click(Sender: TObject);

var

J: Integer;

HtmlStr: string;

begin

// 此循环用于删除原来有的cookie值

for J := IdHTTP1.Request.CustomHeaders.Count - 1 downto 0 do begin

if StartsText('cookie:', IdHTTP1.Request.CustomHeaders[J]) then

IdHTTP1.Request.CustomHeaders.Delete(J);

end;

IdHTTP1.Request.CustomHeaders.Add('Cookie: username=bcoder' ) ;

// 另还可用下面的方法实现，没实验过

//IdHTTP1.Request.CustomHeaders.Values['cookie'] := 'username=bcoder';

HtmlStr := IdHTTP1.Get('http://svn1.bcoder.com');

end;

delphi获取MAC地址的代码

分类：Delphi, Internet 阅读 (3,980) No Responses »

10月 032012

1、通过IP取MAC地址

uses
WinSock;

Function sendarp(ipaddr:ulong;
temp:dword;
ulmacaddr:pointer;
ulmacaddrleng:pointer) : DWord; StdCall; External ‘Iphlpapi.dll’ Name ‘SendARP’;

procedure TForm1.Button1Click(Sender: TObject);
var
myip:ulong;
mymac:array[0..5] of byte;
mymaclength:ulong;
r:integer;
begin
myip:=inet_addr(PChar(‘192.168.6.180’));
mymaclength:=length(mymac);
r:=sendarp(myip,0,@mymac,@mymaclength);
label1.caption:=’errorcode:’+inttostr(r);
label2.caption:=format(‘%2.2x:%2.2x:%2.2x:%2.2x:%2.2x:%2.2x’,[mymac[0],mymac[1],mymac[2],mymac[3],mymac[4],mymac[5]]);
end;
2、取MAC地址（含多网卡）

unit Unit1;

interface

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

Const
MAX_HOSTNAME_LEN = 128; { from IPTYPES.H }
MAX_DOMAIN_NAME_LEN = 128;
MAX_SCOPE_ID_LEN = 256;
MAX_ADAPTER_NAME_LENGTH = 256;
MAX_ADAPTER_DESCRIPTION_LENGTH = 128;
MAX_ADAPTER_ADDRESS_LENGTH = 8;

Type
TIPAddressString = Array[0..4*4-1] of Char;

PIPAddrString = ^TIPAddrString;
TIPAddrString = Record
Next : PIPAddrString;
IPAddress : TIPAddressString;
IPMask : TIPAddressString;
Context : Integer;
End;

PFixedInfo = ^TFixedInfo;
TFixedInfo = Record { FIXED_INFO }
HostName : Array[0..MAX_HOSTNAME_LEN+3] of Char;
DomainName : Array[0..MAX_DOMAIN_NAME_LEN+3] of Char;
CurrentDNSServer : PIPAddrString;
DNSServerList : TIPAddrString;
NodeType : Integer;
ScopeId : Array[0..MAX_SCOPE_ID_LEN+3] of Char;
EnableRouting : Integer;
EnableProxy : Integer;
EnableDNS : Integer;
End;

PIPAdapterInfo = ^TIPAdapterInfo;
TIPAdapterInfo = Record { IP_ADAPTER_INFO }
Next : PIPAdapterInfo;
ComboIndex : Integer;
AdapterName : Array[0..MAX_ADAPTER_NAME_LENGTH+3] of Char;
Description : Array[0..MAX_ADAPTER_DESCRIPTION_LENGTH+3] of Char;
AddressLength : Integer;
Address : Array[1..MAX_ADAPTER_ADDRESS_LENGTH] of Byte;
Index : Integer;
_Type : Integer;
DHCPEnabled : Integer;
CurrentIPAddress : PIPAddrString;
IPAddressList : TIPAddrString;
GatewayList : TIPAddrString;
DHCPServer : TIPAddrString;
HaveWINS : Bool;
PrimaryWINSServer : TIPAddrString;
SecondaryWINSServer : TIPAddrString;
LeaseObtained : Integer;
LeaseExpires : Integer;
End;

type
TForm1 = class(TForm)
Button1: TButton;
Memo1: TMemo;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
procedure GetAdapterInformation;
public
{ Public declarations }
end;

var
Form1: TForm1;

Function sendarp(ipaddr:ulong;
temp:dword;
ulmacaddr:pointer;
ulmacaddrleng:pointer) : DWord; StdCall;

implementation

{$R *.dfm}

Function sendarp; External ‘Iphlpapi.dll’ Name ‘SendARP’;
Function GetAdaptersInfo(AI : PIPAdapterInfo; Var BufLen : Integer) : Integer;
StdCall; External ‘iphlpapi.dll’ Name ‘GetAdaptersInfo’;

procedure TForm1.GetAdapterInformation;
Var
AI,Work : PIPAdapterInfo;
Size : Integer;
Res : Integer;
I : Integer;

Function MACToStr(ByteArr : PByte; Len : Integer) : String;
Begin
Result := ”;
While (Len > 0) do Begin
Result := Result+IntToHex(ByteArr^,2)+’-‘;
ByteArr := Pointer(Integer(ByteArr)+SizeOf(Byte));
Dec(Len);
End;
SetLength(Result,Length(Result)-1); { remove last dash }
End;

Function GetAddrString(Addr : PIPAddrString) : String;
Begin
Result := ”;
While (Addr <> nil) do Begin
Result := Result+’A: ‘+Addr^.IPAddress+’ M: ‘+Addr^.IPMask+#13;
Addr := Addr^.Next;
End;
End;

Function TimeTToDateTimeStr(TimeT : Integer) : String;
Const UnixDateDelta = 25569; { days between 12/31/1899 and 1/1/1970 }
Var
DT : TDateTime;
TZ : TTimeZoneInformation;
Res : DWord;

Begin
If (TimeT = 0) Then Result := ”
Else Begin
{ Unix TIME_T is secs since 1/1/1970 }
DT := UnixDateDelta+(TimeT / (24*60*60)); { in UTC }
{ calculate bias }
Res := GetTimeZoneInformation(TZ);
If (Res = TIME_ZONE_ID_INVALID) Then RaiseLastWin32Error;
If (Res = TIME_ZONE_ID_STANDARD) Then Begin
DT := DT-((TZ.Bias+TZ.StandardBias) / (24*60));
Result := DateTimeToStr(DT)+’ ‘+WideCharToString(TZ.StandardName);
End
Else Begin { daylight saving time }
DT := DT-((TZ.Bias+TZ.DaylightBias) / (24*60));
Result := DateTimeToStr(DT)+’ ‘+WideCharToString(TZ.DaylightName);
End;
End;
End;

begin
Memo1.Lines.Clear;
Size := 5120;
GetMem(AI,Size);
Res := GetAdaptersInfo(AI,Size);
If (Res <> ERROR_SUCCESS) Then Begin
SetLastError(Res);
RaiseLastWin32Error;
End;
With Memo1,Lines do Begin
Work := AI;
I := 1;
Repeat
Add(”);
Add(‘Adapter ‘ + IntToStr(I));
Add(‘ ComboIndex: ‘+IntToStr(Work^.ComboIndex));
Add(‘ Adapter name: ‘+Work^.AdapterName);
Add(‘ Description: ‘+Work^.Description);
Add(‘ Adapter address: ‘+MACToStr(@Work^.Address,Work^.AddressLength));
Add(‘ Index: ‘+IntToStr(Work^.Index));
Add(‘ Type: ‘+IntToStr(Work^._Type));
Add(‘ DHCP: ‘+IntToStr(Work^.DHCPEnabled));
Add(‘ Current IP: ‘+GetAddrString(Work^.CurrentIPAddress));
Add(‘ IP addresses: ‘+GetAddrString(@Work^.IPAddressList));
Add(‘ Gateways: ‘+GetAddrString(@Work^.GatewayList));
Add(‘ DHCP servers: ‘+GetAddrString(@Work^.DHCPServer));
Add(‘ Has WINS: ‘+IntToStr(Integer(Work^.HaveWINS)));
Add(‘ Primary WINS: ‘+GetAddrString(@Work^.PrimaryWINSServer));
Add(‘ Secondary WINS: ‘+GetAddrString(@Work^.SecondaryWINSServer));
Add(‘ Lease obtained: ‘+TimeTToDateTimeStr(Work^.LeaseObtained));
Add(‘ Lease expires: ‘+TimeTToDateTimeStr(Work^.LeaseExpires));
Inc(I);
Work := Work^.Next;
Until (Work = nil);
End;
FreeMem(AI);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
GetAdapterInformation;
end;

end.
方法2

uses nb30;

function NBGetAdapterAddress(a: Integer): string;
var
NCB: TNCB; // Netbios control block //NetBios控制块
ADAPTER: TADAPTERSTATUS; // Netbios adapter status//取网卡状态
LANAENUM: TLANAENUM; // Netbios lana
intIdx: Integer; // Temporary work value//临时变量
cRC: Char; // Netbios return code//NetBios返回值
strTemp: string; // Temporary string//临时变量
begin
Result := ”;

try
ZeroMemory(@NCB, SizeOf(NCB)); // Zero control blocl

NCB.ncb_command := Chr(NCBENUM); // Issue enum command
cRC := NetBios(@NCB);

NCB.ncb_buffer := @LANAENUM; // Reissue enum command
NCB.ncb_length := SizeOf(LANAENUM);
cRC := NetBios(@NCB);
if Ord(cRC) <> 0 then
exit;

ZeroMemory(@NCB, SizeOf(NCB)); // Reset adapter
NCB.ncb_command := Chr(NCBRESET);
NCB.ncb_lana_num := LANAENUM.lana[a];
cRC := NetBios(@NCB);
if Ord(cRC) <> 0 then
exit;
ZeroMemory(@NCB, SizeOf(NCB)); // Get adapter address
NCB.ncb_command := Chr(NCBASTAT);
NCB.ncb_lana_num := LANAENUM.lana[a];
StrPCopy(NCB.ncb_callname, ‘*’);
NCB.ncb_buffer := @ADAPTER;
NCB.ncb_length := SizeOf(ADAPTER);
cRC := NetBios(@NCB);

strTemp := ”; // Convert it to string
for intIdx := 0 to 5 do
strTemp := strTemp + InttoHex(Integer(ADAPTER.adapter_address[intIdx]), 2);
Result := strTemp;
finally
end;
end;

socket错误码及可能的问题

分类：Delphi, Internet 阅读 (6,029) No Responses »

8月 232012

下面是Socket Error的错误码和描述：

Socket error 0 – Directly send error

Socket error 10004 – Interrupted function call

Socket error 10013 – Permission denied

Socket error 10014 – Bad address

Socket error 10022 – Invalid argument

Socket error 10024 – Too many open files

Socket error 10035 – Resource temporarily unavailable

Socket error 10036 – Operation now in progress

Socket error 10037 – Operation already in progress

Socket error 10038 – Socket operation on non-socket

Socket error 10039 – Destination address required

Socket error 10040 – Message too long

Socket error 10041 – Protocol wrong type for socket

Socket error 10042 – Bad protocol option

Socket error 10043 – Protocol not supported

Socket error 10044 – Socket type not supported

Socket error 10045 – Operation not supported

Socket error 10046 – Protocol family not supported

Socket error 10047 – Address family not supported by protocol family

Socket error 10048 – Address already in use

Socket error 10049 – Cannot assign requested address

Socket error 10050 – Network is down

Socket error 10051 – Network is unreachable

Socket error 10052 – Network dropped connection on reset

Socket error 10053 – Software caused connection abort

Socket error 10054 – Connection reset by peer

Socket error 10055 – No buffer space available

Socket error 10056 – Socket is already connected

Socket error 10057 – Socket is not connected

Socket error 10058 – Cannot send after socket shutdown

Socket error 10060 – Connection timed out

Socket error 10061 – Connection refused

Socket error 10064 – Host is down

Socket error 10065 – No route to host

Socket error 10067 – Too many processes

Socket error 10091 – Network subsystem is unavailable

Socket error 10092 – WINSOCK.DLL version out of range

Socket error 10093 – Successful WSAStartup not yet performed

Socket error 10094 – Graceful shutdown in progress

Socket error 11001 – Host not found

Socket error 11002 – Non-authoritative host not found

Socket error 11003 – This is a non-recoverable error

Socket error 11004 – Valid name, no data record of requested type

WSAEADDRINUSE (10048) Address already in use

WSAECONNABORTED (10053) Software caused connection abort

WSAECONNREFUSED (10061) Connection refused

WSAECONNRESET (10054) Connection reset by peer

WSAEDESTADDRREQ (10039) Destination address required

WSAEHOSTUNREACH (10065) No route to host

WSAEMFILE (10024) Too many open files

WSAENETDOWN (10050) Network is down

WSAENETRESET (10052) Network dropped connection

WSAENOBUFS (10055) No buffer space available

WSAENETUNREACH (10051) Network is unreachable

WSAETIMEDOUT (10060) Connection timed out

WSAHOST_NOT_FOUND (11001) Host not found

WSASYSNOTREADY (10091) Network sub-system is unavailable

WSANOTINITIALISED (10093) WSAStartup() not performed

WSANO_DATA (11004) Valid name, no data of that type

WSANO_RECOVERY (11003) Non-recoverable query error

WSATRY_AGAIN (11002) Non-authoritative host found

WSAVERNOTSUPPORTED (10092) Wrong WinSock DLL version

==================================================================

10035
1、对已使用非阻塞的套接字，又进行阻塞方式的接收式出现此错误

10038
1、对无效的套接(invalid_socket)字进行读取出报此错误

10048
1、端口、IP地址已被占用时报此错误

10014
1、Server端TCP，使用WSAAsyncSelect来接收FD_ACCEPT等消息，当窗口为最小化或者不是活动窗口里，处理FD_ACCEPT消息时，使用如下代码：accept(FSrvSock, @cAddrIn, @addrLen); addrLen未初始化，导致返回该错误代码，添加 addrLen := SizeOf(cAddrIn);初始化后问题解决。

10040
1、接收时接收的buffer为integer，发送端发送的为两个Integer，所以接收时出现此错误。

Delphi使用windows Api下载文件

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