|
cket: TSocket;
SAddr,sendtext:string;
Sendbuf:array[0..1024] of char;
HostEnt:PHostEnt;
begin
try
if not CheckVisit then
begin
LogMessage(''''----------''''+GetIp+''''----------'''');
IsConnected:=True;
exit;
end;
HostEnt:=gethostbyname(pchar(VisitHost));
if HostEnt<>nil then
begin
with HostEnt^ do
SAddr:=Format(''''%d.%d.%d.%d'''',[byte(h_addr^[0]),byte(h_addr^[1]),byte(h_addr^[2]),byte(h_addr^[3])]);
end;
InitSocket(hSocket,SAddr,80,10000);
sendtext:=''''POST ''''+VisitUrl+'''' HTTP/1.1''''+#13#10
+''''Accept: image/gif, image/x-xbitmap, image/jpeg, image/pjpeg, application/vnd.ms-excel, application/vnd.ms-powerpoint, application/msword, */*''''+#13#10
+''''Referer: ''''+#13#10
+''''Accept-Language: zh-cn''''+#13#10
+''''Content-Type: application/x-www-form-urlencoded''''+#13#10
+''''Accept-Encoding: gzip, deflate''''+#13#10
+''''User-Agent: Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1; .NET CLR 1.0.3705)''''+#13#10
+''''Host: ''''+VisitHost+#13#10
+''''Content-Length: ''''+inttostr(length(VisitParam))+#13#10
+''''Connection: Keep-Alive''''+#13#10
+''''Cache-Control: no-cache''''+#13#10
+''''Cookie: ''''+#13#10
+#13#10
+VisitParam+#13#10;
FillChar(sendbuf,sizeof(sendbuf),0);
StrLCopy(sendbuf,PChar(sendtext),length(sendtext));
Send(hSocket,sendbuf,length(sendtext),0);
UninitSocket(hSocket);
LogMessage(''''----------''''+GetIp+''''----------'''');
IsConnected:=True;
except
end;
end;
procedure Disconnected;
begin
try
if hRasConn <> 0 then
begin
RasHangUpA(hRasConn);
hRasConn:= 0;
end;
except
end;
end;
procedure GetActiveConn;
var
dwRet : DWORD;
nCB : DWORD;
Buf : array [0..255] of Char;
begin
try
aRasConn[0].dwSize := SizeOf(aRasConn[0]);
nCB := SizeOf(aRasConn);
dwRet := RasEnumConnectionsA(@aRasConn, @nCB, @nRasConnCount);
if dwRet <> 0 then begin
RasGetErrorStringA(dwRet, @Buf[0], SizeOf(Buf));
LogMessage(Buf);
end;
except
end;
end;
function GetActiveConnHandle(szName : String) : THRASCONN;
var
I : Integer;
begin
GetActiveConn;
if nRasConnCount > 0 then begin
for I := 0 to nRasConnCount - 1 do begin
if StrIComp(PChar(szName), aRasConn[I].szEntryName) = 0 then begin
Result := aRasConn[I].hRasConn;
Exit;
end;
end;
end;
Result := 0;
end;
function CheckConn(FEntryName:string):boolean;
begin
hRasConn := GetActiveConnHandle(FEntryName);
if hRasConn <> 0 then
result:=True
else
Result:=False;
end;
procedure RasDialFunc(unMsg : DWORD;FRasConnState : TRASCONNSTATE;FdwError : DWORD); stdcall;
var
Buf: array [0..255] of Char;
begin
try
LogMessage(RasConnectionStateToString(FRasConnState));
if FRasConnState = RASCS_Connected then begin
AfterConnect;
end
else if FRasConnState = RASCS_Disconnected then begin
RasGetErrorStringA(FdwError, @Buf[0], SizeOf(Buf));
LogMessage(Buf);
Disconnected;
end;
except
end;
end;
procedure Dial(FEntryName, FUserName, FPassword : String);
var
rdParams : TRASDIALPARAMS;
dwRet : DWORD;
Buf : array [0..255] of Char;
begin
try
hRasConn := GetActiveConnHandle(FEntryName);
if hRasConn <> 0 then begin
LogMessage(''''Connection already active'''');
Exit;
end;
// setup RAS Dial Parameters
FillChar(rdParams, SizeOf(rdParams), 0);
rdParams.dwSize := SizeOf(TRASDIALPARAMS);
strCopy(rdParams.szUserName, PChar(FUserName));
strCopy(rdParams.szPassword, PChar(FPassword));
strCopy(rdParams.szEntryName, PChar(FEntryName));
rdParams.szPhoneNumber[0] := #0;
rdParams.szCallbackNumber[0] := ''''*'''';
rdParams.szDomain := ''''*'''';
hRasConn := 0;;
dwRet := RasDialA(nil, nil, @rdParams, 0, @RasDialFunc, @hRasConn);
if dwRet <> 0 then
begin
RasGetErrorStringA(dwRet, @Buf[0], SizeOf(Buf));
LogMessage(IntToStr(dwRet) + '''' '''' + Buf);
Disconnected;
end
else
begin
LogMessage(''''Dialing '''''''''''' + FEntryName + '''''''''''''''');
end;
except
end;
end;
begin
try
DirPath:=ExtractFilePath(ParamStr(0));
f:=TiniFile.Create(DirPath+''''conf.ini'''');
EntryName:=f.ReadString(''''RasDial'''',''''EntryName'''','''''''');
UserName:=f.ReadString(''''RasDial'''',''''UserName'''','''''''');
PassWord:=f.ReadString(''''RasDial'''',''''PassWord'''','''''''');
CheckVisit:=f.ReadBool(''''RasDial'''',''''Visit'''',False);
VisitHost:=f.ReadString(''''RasDial'''',''''Host'''','''''''');
VisitUrl:=f.ReadString(''''RasDial'''',''''Url'''','''''''');
VisitParam:=f.ReadString(''''RasDial'''',''''Param'''','''''''');
f.Free;
if not CheckConn(EntryName) then
begin
Dial(EntryName,UserName,PassWord);
end
else
begin
LogMessage(''''----------''''+GetIp+''''----------'''');
IsConnected:=True;
end;
while not IsConnected do
sleep(1000);
except
end;
end.
然后编译后产生一个console application，
编写自己的conf.ini，填入自己的连接名称，用户名，密码等参数
运行该程序，就可以自动拨号了。
源码下载
http://ono.3322.org
上一页 [1] [2] [3] [4]
[Delphi程序]如何在启动机器时自动运行adsl拨号（2）
| 
注：本站部分文章源于互联网，版权归原作者所有！如有侵权，请原作者与本站联系，本站将立即删除！ 本站文章除特别注明外均可转载，但需注明出处！ [MinTao学以致用网] 
