main.pas

短信网关接口源代码

    if ClientSocket.Active then
    begin
      if database1.Connected then database1.Close;
      database1.ConnectionString := 'FILE NAME='+'.\Business.udl';
      database1.Connected := True;
    end;
  except
    ClientShow('['+DatetimeTostr(Now)+'] 提示：连接出错，判断IP地址或端口是否正确！'+#10#13);
    RefreshIP;
    exit;
  end;

  if ClientSocket.Active then
  begin
    if CurFile <> '' then
      CloseFile(ClientFile);
    CurFile := DatetimeTostr(Now);
    CurFile := copy(CurFile,1,4)+copy(CurFile,6,2)+copy(CurFile,9,2);
    FileAttrs := faAnyFile;
    AssignFile(ClientFile, CurFile+'_C.txt'); { File selected in dialog }
    if FindFirst(CurFile+'_C.txt', FileAttrs, sr) = 0 then  Append(ClientFile)
    else ReWrite(ClientFile);

    DateNum := 0;
    SendMsg(Format('Login Name=%s&Pwd=%s&Type=0&version=%s', [id, pwd, sp_version]));
  end else begin
    ClientShow('['+DatetimeTostr(Now)+'] 提示：连接失败！');
    RefreshIP;
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  CommandID := 1000;
  CurFile := '';
  ConnSuccess := False;
  FirstCreate := True;
  sp_version := '';
  Application.OnException := AppException;
end;

procedure TForm1.ClientSocketRead(Sender: TObject;
  Socket: TCustomWinSocket);
var Msg, MsgFlag, sTemp: string;
  i: integer;
  MsgList : TStringList;
begin
  MsgList := TStringList.Create;
  MsgList.Text := Socket.ReceiveText;
  for i := 0 to MsgList.Count -1 do
  begin
    Msg := MsgList.Strings[i];
    MsgFlag := LowerCase(Trim(Msg));
    if MsgFlag = '' then Continue;
    ClientShow(Format('[%s] 接收 %s',[DatetimeTostr(Now), Msg]));

    if  copy(MsgFlag,1,4)='pass' then
    begin
      Times := 0;
      ClientShow('['+DatetimeTostr(Now)+'] 提示：验证身份成功！Successed！');
      Timer1.Enabled := True;
      Timer2.Enabled := True;
      ConnSuccess := True;
      timeDelay(1000);
      application.Minimize;
    end else if copy(MsgFlag, 1, 10)='activetest' then
    begin
      SendMsg('Received CommandId='+subcopy(Msg, 'commandid')+#13#10);
    end else if copy(MsgFlag, 1, 7)='deliver' then
    begin
      SendMsg('Received CommandId='+subcopy(msg, 'commandid')+#13#10);
      stemp := 'INSERT INTO msgcomm(GateName, smid, smmobile, smcalled, smfee, smfeeno, smfmt, smmsgs, scheduletime, expiretime, mtflag, MsgId, reportflag, sendtime, extdata, smflag)'+
               ' VALUES(null, ''%s'',''%s'', ''%s'', 1, null, %d, ''%s'', null, null, 0, null, 0, getdate(), null, 1)';
      ExecQuery(query1, Format(stemp, ['103901', subcopy(msg,'usernumber'), subcopy(msg,'spnumber'), strToint(subcopy(msg,'msgcode')),UnicodeToAnsi(subcopy(msg,'msg:'))]));
    end else if copy(MsgFlag, 1, 6)='report' then
    begin
      SendMsg('Received CommandId='+subcopy(msg, 'commandid')+#13#10);
      stemp := subcopy(Msg, 'msgid');
      with query1 do
      begin
        stemp := 'INSERT INTO reportcomm(Commandid, extdata, msgid, Gatename, state) VALUES(''%s'',''%s'', ''%s'', null, ''%s'')';
        ExecQuery(query1, Format(stemp, [subcopy(Msg, 'commandid'), subCopy(Msg, 'ExtData'), subCopy(Msg, 'msgid'), subcopy(Msg, 'state')]));
      end;
    end else if copy(MsgFlag, 1, 6)='regist' then
    begin
      strRegCode := strToint(subCopy(Msg, 'result'));
      strStep := strToInt(subCopy(Msg, 'step'));
      if form2 <> nil then
        form2.Panel3.Caption := subcopy(Msg, 'errmsg');
    end else if copy(MsgFlag, 1, 8)='received' then Times := 0;
  end;
  MsgList.Free;
end;

procedure TForm1.AppException(Sender: TObject; E: Exception);
begin
  ClientShow(Format('[%s] 提示 程序错误：%s',[DatetimeTostr(Now), E.Message ]));
end;

procedure TForm1.SaveHisData;
var
  dt: string;
begin
  dt := DatetimeTostr(Now);
  dt := copy(dt,1,4)+copy(dt,6,2)+copy(dt,9,2);
  if dt <> curFile then
  begin
    CurFile := dt;
    CloseFile(ClientFile);
    AssignFile(ClientFile, CurFile+'_C.txt'); { File selected in dialog }
    ReWrite(ClientFile);
  end;
end;

procedure TForm1.ClientShow(s: string);
begin
  if memo1.Lines.Count > 200 then memo1.Clear;
  Memo1.Lines.Add(s);
  if CurFile <> '' then
  begin
    Writeln(ClientFile, s);
    Flush(ClientFile);
    SaveHisData;
  end;
end;

procedure TForm1.Timer2Timer(Sender: TObject);
var Msg: string;
  id: integer;

  Function BuildMsgID: string;
  var
    Present: TDateTime;
    Year, Month, Day, Hour, Min, Sec, MSec: Word;
  begin
    Present:= Now;
    DecodeDate(Present, Year, Month, Day);
    DecodeTime(Present, Hour, Min, Sec, MSec);
    result := Format('%.2d%.2d%.2d%.2d%.2d00%.4d%.3d',[Month, Day, Hour, Min, Sec, MSec, id]);
  end;
begin
  Timer2.Enabled := False;
  if ConnSuccess and ClientSocket.Active and Database1.Connected then
  begin
    with query2 do
    begin
      //database1.StartTransaction;
      database1.BeginTrans;
      try
        Open;
        if not isEmpty then
          ExecQuery(qryTemp, 'Delete From msgcomm');
        //database1.Commit;
        database1.CommitTrans;
      except
        if database1.InTransaction then database1.RollbackTrans;// .Rollback;
        Timer2.Enabled := True;
        exit;
      end;
      if query2.IsEmpty then
      begin
        Timer2.Enabled := True;
        Close; Exit;
      end;

      First;
      id := 1;
      While not Eof do
      begin
        if FieldByName('smflag').AsInteger = 0 then
        begin
          inc(CommandID);
          Msg := Format('Submit CommandId=%d', [CommandID]);
          if not FieldByName('gatename').IsNull then Msg := Msg + '&GateName='+FieldByName('gatename').Asstring;
          if not FieldByName('smid').IsNull then Msg := Msg + '&ITEMID='+FieldByName('smid').Asstring;
          if not FieldByName('smcalled').IsNull then Msg := Msg + '&SpNumber='+FieldByName('smcalled').Asstring;
          if not FieldByName('smmobile').IsNull then Msg := Msg + '&UserNumber='+FieldByName('smmobile').Asstring;
          if not FieldByName('smfeeno').IsNull then Msg := Msg + '&FeeNumber='+FieldByName('smfeeno').Asstring;
          if not FieldByName('smfee').IsNull then Msg := Msg + Format('&FeeType=%d',[FieldByName('smfee').Asinteger]);
          if not FieldByName('scheduletime').IsNull then Msg := Msg + '&ScheduleTime='+FieldByName('scheduletime').Asstring;
          if not FieldByName('expiretime').IsNull then Msg := Msg + '&ExpireTime='+FieldByName('expiretime').Asstring;
          if not FieldByName('mtflag').IsNull then Msg := Msg + Format('&MtFlag=%d',[FieldByName('mtflag').Asinteger]);
          if not FieldByName('reportflag').IsNull then Msg := Msg + Format('&ReportFlag=%d',[FieldByName('reportflag').Asinteger]);
          if not FieldByName('smfmt').IsNull then Msg := Msg + Format('&MsgCode=%d',[FieldByName('smfmt').Asinteger]);
          Msg := Msg + '&MsgId='+BuildMsgID;
          if not FieldByName('extdata').IsNull then Msg := Msg + '&ExtData:='+FieldByName('extdata').Asstring;
          if not FieldByName('smmsgs').IsNull then Msg := Msg + '&Msg:='+AnsiToUnicode(FieldByName('smmsgs').Asstring);
          SendMsg(Msg);
          Application.ProcessMessages;
          inc(id);
        end;
        Next;
      end;
      Close;
    end;
  end;
  Timer2.Enabled := True;
end;

procedure TForm1.ApplicationEvents1Minimize(Sender: TObject);
begin
  form1.Hide;
end;

procedure TForm1.FormShow(Sender: TObject);
begin
  Application.Restore;
end;

procedure TForm1.FormActivate(Sender: TObject);
var
  IniFile: TIniFile;
  id, pwd : string;
begin
  IniFile := TIniFile.Create('.\TCP.INI');
  id := IniFile.ReadString('configs','id','');
  pwd := IniFile.ReadString('configs','spwd','');
  IniFile.Free;

  if (id = '') or (pwd = '') then
  begin
    Button1Click(nil);
  end else if FirstCreate then
  begin
    FirstCreate := False;
    ConnectServer;
  end;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  if CurFile <> '' then
  begin
    CloseFile(ClientFile);
    CurFile := '';
  end;
  Action := caFree;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  Application.CreateForm(TForm2, Form2);
  try
    Form2.showModal;
    if Form2.btnOk then
    begin
      ClientSocket.Active := False;
      FirstCreate := False;
      ConnectServer;
    end;
  finally
    Form2.Free;
  end;
end;


procedure TForm1.Button2Click(Sender: TObject);
begin
  RefreshIP;
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
  ConnectServer;
end;

end.