main.pas

短信网关接口源代码

unit main;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, ScktComp, DB, DBTables, ADODB, IniFiles,
  ImgList, AppEvnts;


type
  TForm1 = class(TForm)
    ClientSocket: TClientSocket;
    Panel1: TPanel;
    Memo1: TMemo;
    Timer1: TTimer;
    Timer2: TTimer;
    Database1: TADOConnection;
    Query1: TADOQuery;
    Query2: TADOQuery;
    qryTemp: TADOQuery;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Label4: TLabel;
    Label5: TLabel;
    Bevel2: TBevel;
    procedure Timer1Timer(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure ClientSocketRead(Sender: TObject; Socket: TCustomWinSocket);
    procedure Timer2Timer(Sender: TObject);
    procedure ApplicationEvents1Minimize(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
  private
    { Private declarations }
    CommandID, Times: integer;
    DateNum: Longint;
    FirstCreate : Boolean;
    procedure ConnectServer;
    procedure AppException(Sender: TObject; E: Exception);
    procedure SaveHisData;
    procedure ClientShow(s: string);
    procedure RefreshIP;
  public
    { Public declarations }
    ConnSuccess: Boolean;
    Clients : TList;
    sp_version, called, curFile: String;
    ClientFile: TextFile;
    strStep, strRegCode : integer;
    procedure SendMsg(Msg: string);
  end;

var
  Form1: TForm1;
Procedure TimeDelay(DT:DWORD);

implementation

{$R *.dfm}
uses regForm;

Procedure TimeDelay(DT:DWORD);
var
 TT:DWORD;
begin
  //取得现在的Tick值
  TT:=GetTickCount();
  //计算Tick差值是否超过设置值
  while GetTickCount()-TT<DT do
    Application.ProcessMessages; //释放控制权
end;

procedure TForm1.SendMsg(Msg: string);
begin
  ClientShow(Format('[%s] 发送 %s',[DatetimeTostr(Now), Msg]));
  try
    ClientSocket.Socket.SendText(Msg+#13#10);
  except
    ConnSuccess := False;
    ClientShow(Format('[%s] 连接错误！',[DatetimeTostr(Now)]));
    ConnectServer;
  end;
end;

procedure OpenQuery(query: TADOQuery; S: String);
begin
  with query do
  begin
    Close;
    Sql.Clear; Sql.Add(S);
    Open;
  end;
end;

procedure ExecQuery(query: TADOQuery; S: String);
begin
  with query do
  begin
    Close;
    Sql.Clear; Sql.Add(S);
    ExecSql;
  end;
end;

function SubCopy(Msg, StrID: string):string;
var bpos, mpos: integer;
  lMsg, stemp, bs, ms: string;
begin
  result := '';
  lMsg := Msg;
  repeat
    bpos := Pos(LowerCase(StrID), LowerCase(LMsg));
    bs := copy(LMsg, bpos-1, 1);
    mpos := bpos+Length(StrID);
    ms := copy(LMsg, mpos, 1);
    if ((bs = ' ') or (bs = '&')) and (ms = '=') then
    begin
      stemp := copy(LMsg, mPos+1, Length(LMsg)-mpos+1);
      bpos := Pos('&', stemp);
      if bpos > 0 then sTemp := Copy(stemp, 1, bpos-1);
      result := Trim(sTemp);
      break;
    end;
    LMsg := Copy(LMsg, mpos, Length(LMsg)-mpos);
  until bpos <= 0;
end;

function AnsiToUnicode(Ansi: string):string;
var
  s:string;
  i, slen:integer;
  j:string[2];
begin
  s:='';
  sLen := length(Ansi);
  for i := 1 to sLen do
  begin
    if i mod 2 = 1 then
      j:=IntToHex(word(ansi[i]) shl 8,2)
    else j:=IntToHex(word(ansi[i]),2);
    s:=s+j;
  end;
  Result :=s;
end;

function HexToInt(hex: char): integer;
begin
  if (hex >='1') and (hex <= '9') then result := strToInt(hex)
  else if  ((hex >= 'a') and (hex <= 'f')) then result := integer(hex)- integer('a') + 10
  else if (hex >= 'A') and (hex <= 'F') then result := integer(hex)- integer('A') + 10
  else result := 0;
end;

function UnicodeToAnsi(Unicode: string):string;
var
  s:string;
  i, slen, m, n:integer;
begin
  s:='';
  sLen := length(Unicode) div 2 ;
  for i := 1 to sLen do
  begin
    m := HexToInt(Unicode[i*2-1]);
    n := HexToInt(Unicode[i*2]);
    s := s+chr(m *16 +n);
  end;
  Result :=s;
end;

procedure TForm1.RefreshIP;
var
  hDll:THandle;
  GetIP: function: string;
  strDllName,strErrMsg, s: String;
  F: TextFile;
  IniFile: TIniFile;
begin
  {从服务器中下载并更新IP}
  ClientShow('['+DatetimeTostr(Now)+'] 提示：现正在更新IP地址，大约需要十多秒，请稍等...');
  strDllName:='.\GetIPInfo.dll';//得到Dll所在
  hDll:=LoadLibrary(PChar(strDllName));//加载Dll
  if(hDll<=0) then
  begin
    ClientShow('['+DatetimeTostr(Now)+'] 对不起，不能加载文件GetIPInfo.dll，请确认文件是否存在。');
    exit;
  end;

  GetIP:=GetProcAddress(hDll,'GetIP');
  if not Assigned(GetIP) then
  begin
    Freelibrary(hDll);
    ClientShow('['+DatetimeTostr(Now)+'] 对不起，文件GetIPInfo.dll没有信息发送功能，请确认文件是否正确。');
    Exit;
  end else
    GetIP;

  Freelibrary(hDll);

  {读取IP地址}
  AssignFile(F, '.\ip.asp');
  Reset(F);
  readln(F, s);
  CloseFile(F);
  {最新IP写入INI文件中}
  IniFile := TIniFile.Create('.\spClient.ini');
  IniFile.WriteString('configs','ip',s);
  IniFile.Free;
  ClientShow('['+DatetimeTostr(Now)+'] 提示：更新完毕，请重新运行程序！')
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
  if (Times > 3) or (not ClientSocket.Active)  then
  begin
    if ClientSocket.Active then
    begin
      ClientSocket.Close;
      TimeDelay(1000);
      ConnSuccess := False;
    end;
    ConnectServer;
    Exit;
  end;

  if ClientSocket.Active then
  begin
    if CommandID > 9999 then CommandID := 1000 else inc(CommandID);
    SendMsg('ActiveTest CommandId='+intTostr(CommandID));
    Inc(Times);
  end;
end;

procedure TForm1.ConnectServer;
var FileAttrs: Integer;
  sr: TSearchRec;
  IniFile: TIniFile;
  ports :integer;
  id, pwd, ip : string;
  TT: dWord;
begin
  IniFile := TIniFile.Create('.\spClient.ini');
  ports := IniFile.ReadInteger('configs','ports',8021);
  ip := IniFile.ReadString('configs','ip','211.162.36.89');
  sp_version := IniFile.ReadString('configs','version','1.1.1.0');
  IniFile.Free;

  IniFile := TIniFile.Create('.\TCP.INI');
  id := IniFile.ReadString('configs','id','100');
  pwd := IniFile.ReadString('configs','spwd','');
  Called := IniFile.ReadString('configs','called','91603318');
  IniFile.Free;
  try
    ConnSuccess := False;
    Timer2.Enabled := False;
    ClientShow('['+DatetimeTostr(Now)+'] 提示：正在连接...到 '+ip+' ！');
    if ClientSocket.Active then ClientSocket.Close;
    ClientSocket.Address := ip;
    ClientSocket.Port := ports;
    ClientSocket.Host := ClientSocket.Address;
    ClientSocket.Active := True;
    TT:=GetTickCount();
    while (GetTickCount()-TT<8000) and (not ClientSocket.Active) do
      Application.ProcessMessages;