main.~pas

通过网关发手机短信

unit Main;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, RzPanel, Trayico, Menus, Buttons, ComCtrls,
  RzButton, DB, ADODB, RzLabel,DBClient,StrUtils;

type

   TSetupInfo = record
    FAutoRun: boolean;
    FServer: string[100];
    FDatabase: string[100];

    FUserName: string[100];
    FPassword: string[100];
    FDbUserName: string[100];
    FDbPassword: string[100];
    FTxDatabase  : string[100];
  end;
  PSetupInfo = ^TSetupInfo;

  TForm1 = class(TForm)
    PopuRight: TPopupMenu;
    N1: TMenuItem;
    N2: TMenuItem;
    N3: TMenuItem;
    N4: TMenuItem;
    TrayIco: TRxTrayIcon;
    RzPanel1: TRzPanel;
    TimerShow: TTimer;
    RzPanel2: TRzPanel;
    RzGroupBox1: TRzGroupBox;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    edServer: TEdit;
    edtxDatabase: TEdit;
    edDbUser: TEdit;
    edDbPass: TEdit;
    edUser: TEdit;
    edPass: TEdit;
    OkCmd: TBitBtn;
    cbAutoRun: TCheckBox;
    RzBitBtn2: TRzBitBtn;
    RzBitBtn3: TRzBitBtn;
    RzPanel3: TRzPanel;
    Panel2: TPanel;
    Label7: TLabel;
    SpeedButton1: TSpeedButton;
    SpeedButton2: TSpeedButton;
    SpeedButton4: TSpeedButton;
    SaveDlg: TSaveDialog;
    RED1: TRichEdit;
    ADOConnObject: TADOConnection;
    AdoQry: TADOQuery;
    Label8: TLabel;
    EdSboDb: TEdit;
    procedure FormShow(Sender: TObject);
    procedure OkCmdClick(Sender: TObject);
    procedure TrayIcoDblClick(Sender: TObject);
    procedure N2Click(Sender: TObject);
    procedure N1Click(Sender: TObject);
    procedure N4Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormDestroy(Sender: TObject);
    procedure RzBitBtn3Click(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
    procedure SpeedButton4Click(Sender: TObject);
    procedure SpeedButton2Click(Sender: TObject);
    procedure RzBitBtn2Click(Sender: TObject);
    procedure TimerShowTimer(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    private

    procedure Save;
    procedure SetConnected(AValue: boolean);
    procedure ShowResultMsg(num: Integer);
    procedure loginin;
    procedure sendSms;
    procedure  ReceiveSms  ;
    procedure CkFlow(AKey: Variant; AUser: string; FCancel: integer;
      Fnote: string);
    procedure ExecSQL(s:string);
    procedure OpenSQL(s: string);
    procedure getContent(AstrFrom, AstrContent: string);
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
function GlbSetupInfo: TSetupInfo;
procedure LoadSetupInfo(var ARec: TSetupInfo);
procedure SaveSetupInfo(const ARec: TSetupInfo);

implementation
 uses SelfFunc,TimerDlg,SP_Utils;
{$R *.dfm}

 var
  FPSetupInfo: PSetupInfo = nil;

 const
   config_file_old = 'tsconfig.dat';
  config_file = 'tssetup.dat';

function Sms_Proxy(lProxyType: longint; pProxyHost: string; lProxyPort: longint; pProxyUser: string; pProxyPasswd: string): longint; stdcall;
  external 'SmsSdk.dll';
function Sms_Connect(pServer: string; lCorpID: longint; pLoginName: string; pPasswd: string; lTimeOut: longint; HWND: HWND): longint; stdcall;
  external 'SmsSdk.dll';
procedure Sms_DisConnect();
  external 'SmsSdk.dll';
function Sms_Send(pMobile: string; pMsg: string; lSmsID: plongint): longint; stdcall;
  external 'SmsSdk.dll';
function Sms_Get(pNo: pchar; pMsg: pchar; pTime: pchar): longint; stdcall;
  external 'SmsSdk.dll';


function GlbSetupInfo: TSetupInfo;
begin
  if FPSetUpInfo = nil then
  begin
    New(FPSetupInfo);
    LoadSetupInfo(FPSetUpInfo^);
  end;
  Result := FPSetUpInfo^;
end;

procedure Encripty(var ARec: TSetupInfo; ASize: integer);
var
  pc: PChar;
  i: integer;
begin
  pc := PChar(@ARec);
  for i := 0 to ASize - 1 do
    pc[i] := chr(ord(pc[i]) xor $57);
end;

procedure InitSetupRec(var ARec: TSetupInfo);
begin
  with ARec do
  begin
    FAutoRun := true;
    FServer := '(local)';
    FDatabase := 'SboDemo_china';
   
    FTxDatabase := 'Txsbo';
    FUserName := '28151:admin';
    FPassword := '123456';
    FDbUserName := 'sa';
    FDbPassword := '';

  end;
end;

procedure LoadSetupInfo(var ARec: TSetupInfo);
var
  st: TStream;
  sf: string;

  procedure _LoadOld;
  begin
    sf := ExtractFilePath(ParamStr(0)) + config_file_old;
    if not FileExists(sf) then
      Exit;
    st := TFileStream.Create(sf, fmOpenReadWrite);
    st.Read(ARec, st.Size);
    st.Free;
  end;

begin
  InitSetupRec(ARec);
  sf := ExtractFilePath(ParamStr(0)) + config_file;
  if not FileExists(sf) then
  begin
    _LoadOld;
    Exit;
  end;
  st := TFileStream.Create(sf, fmOpenReadWrite);
  st.Read(ARec, st.Size);
  Encripty(ARec, st.Size); //解密
  st.Free;
end;

procedure SaveSetupInfo(const ARec: TSetupInfo);
var
  st: TStream;
  sf: string;
  ARec1: TSetupInfo;
begin
  sf := ExtractFilePath(ParamStr(0)) + config_file;
  st := TFileStream.Create(sf, fmCreate);
  ARec1 := ARec;
  Encripty(ARec1, SizeOf(TSetupInfo)); //加密
  st.Write(ARec1, SizeOf(TSetupInfo));
  st.Free;
end;



procedure TForm1.FormShow(Sender: TObject);
begin
with GlbSetupInfo do
  begin
    cbAutoRun.Checked := FAutoRun;
    edServer.Text := FServer;
    edtxDatabase.Text := FtxDatabase;
    edsbodb.Text := FDatabase;
    edDbUser.Text := FDbUserName;
    edDbPass.Text := FDbPassword;
    edUser.Text := FUserName;
    edPass.Text := FPassword;

  end;

  


end;


procedure TForm1.Save;
var
  ARec: TSetupInfo;
begin
  with ARec   do
  begin
    FAutoRun := cbAutoRun.Checked;
    FServer := edServer.Text;
    FTxDatabase := edtxDatabase.Text;
    FDatabase:=  edsbodb.Text;
    FDbUserName := edDbUser.Text;
    FDbPassword := edDbPass.Text;
    FUserName := edUser.Text;
    FPassword := edPass.Text;


  AutoLaunch_Add(ParamStr(0), 'TX-SBO短信服务器', 0);
  end;
  SaveSetupInfo(ARec);
  FPSetupInfo^ := ARec;
end;

procedure TForm1.OkCmdClick(Sender: TObject);
begin

  Save;

  SetConnected(true);
  RED1.lines.add('登录成功');
  RzBitBtn2Click(nil);
 

 
  Modalresult := mrOk;
end;

procedure TForm1.TrayIcoDblClick(Sender: TObject);
begin
  Show;
end;

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

procedure TForm1.N1Click(Sender: TObject);
begin
  show;
end;

procedure TForm1.N4Click(Sender: TObject);
begin
   Tag := 1;
  Close;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
if (Tag = 0) and TrayIco.Active then
  begin
    Action := caNone;
    Hide;
    Exit;
  end;
  if not MsgBoxSel('确定要退出 '+ Caption +' 吗?') then
  begin
    Action := caNone;
    Tag := 0;
  end;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  TrayIco.Active := false;
end;

procedure TForm1.RzBitBtn3Click(Sender: TObject);
begin
   Save;
   hide;
end;

procedure TForm1.SpeedButton1Click(Sender: TObject);
begin
 if Red1.Lines.Count > 0 then
  if MsgBoxSel('确定要清除所有记录吗?') then
    Red1.Clear;
end;

procedure TForm1.SpeedButton4Click(Sender: TObject);
begin
 if REd1.SelText = '' then
    Exit;
  REd1.CopyToClipboard;
  MsgBoxInfo('已经复制到剪贴板!');
end;

procedure TForm1.SpeedButton2Click(Sender: TObject);
begin
 if Red1.Lines.Count > 0 then
  if SaveDlg.Execute then
    Red1.Lines.SaveToFile(SaveDlg.FileName);
end;

procedure TForm1.SetConnected(AValue: boolean);
var Adoquery:tadoquery;
    procedure SetConnString(aServer, adb, aUser, aPass: string);
    begin
      ADOConnObject.Cancel;
      ADOConnObject.Connected := false;
      ADOConnObject.ConnectionString :=
      'Provider=SQLOLEDB.1;Persist Security Info=False;' +
      'User ID='+ aUser +';' +
      'Initial Catalog='+ adb +';' +
      'Data Source=' + aServer + ';' +
      'Password=' + aPass + ';' +
      'Use Procedure for Prepare=1;Auto Translate=True;' +
      'Packet Size=4096;Workstation ID=SYX;'+
      'Use Encryption for Data=False;'+
      'Tag with column collation when possible=False';
    end;

begin


    if AValue then
    begin
     SetConnString(edServer.Text , edtxDatabase.Text , edDbUser.Text , edDbPass.Text );
     ADOConnObject.Connected := AValue;


      if  ADOConnObject.Connected then
      loginin ;

    end
    else
    begin
       ADOConnObject.Connected := false;
     
    end;


  end;

//----------用户登陆--------------------------------------------

procedure TForm1.loginin;
var
    DllPaht: string; // DLL的地址
    rtn: Integer;
begin
     //判断是否登陆
    if (OneHandle <> 0) or (pRtnHandle <> 0) then begin
            RED1.Lines.Add(  '你已经登陆了！');
            exit;
        end;

    try
        DllPaht := ExtractFilePath(Paramstr(0)) + 'JL_ISP.dll'; //获得DLL的地址
        OneHandle := LoadLibrary(PChar(DllPaht)); //动态载入DLL，并返回其句柄
        if OneHandle <> 0 then {//如果载入成功则获取ShowCalendar函数的地址}  begin
                @JL_HttpLogin := GetProcAddress(OneHandle, 'JL_HTTPLogin');
                @JL_Logout := GetProcAddress(OneHandle, 'JL_Logout');
                @JL_ModifyPassword := GetProcAddress(OneHandle, 'JL_ModifyPassword');
                @JL_SendMsg := GetProcAddress(OneHandle, 'JL_SendMsg');
                @JL_GetAccountRegTime := GetProcAddress(OneHandle, 'JL_GetAccountRegTime');
                @JL_GetAccountDenyTime := GetProcAddress(OneHandle, 'JL_GetAccountDenyTime');
                @JL_GetAccountType := GetProcAddress(OneHandle, 'JL_GetAccountType');
                @JL_GetAccountPrice := GetProcAddress(OneHandle, 'JL_GetAccountPrice');
                @JL_GetAccountBalance := GetProcAddress(OneHandle, 'JL_GetAccountBalance');
                @JL_GetSendCount := GetProcAddress(OneHandle, 'JL_GetSendCount');
                @JL_ReceiveSM := GetProcAddress(OneHandle, 'JL_ReceiveSM');
                @JL_GetOneSM := GetProcAddress(OneHandle, 'JL_GetOneSM');
            end;

        if not (@JL_HttpLogin = nil) then begin
                rtn := JL_HttpLogin(//函数定义见Type部分。
                    'www.surge.com.cn',
                    7001,
                    PChar(edUser.text),
                    PChar(edPass.text),
                    '88888888',