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]