?? main.pas
字號:
@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',
@pRtnHandle);
if rtn <> 0 then
begin
pRtnHandle := 0;
OneHandle := 0;
ShowResultMsg(rtn);
end
else
begin
RED1.Lines.Add('登錄成功');
end;
end
else
RaiseLastOSError;
except
on E: Exception do
RED1.Lines.Add('系統嚴重錯誤，請重新登陸！!'+#13#10 + E.Message);
end;
end;
//------返回錯誤列表--------------------------------------------------
procedure TForm1.ShowResultMsg(num: Integer);
var s :string;
begin
case num of
0: s:= '正常!';
-1: s:= 'EPID錯誤';
-2: s:= '無該用戶';
-3: s:= '注冊碼錯';
-4: s:= '用戶被停用';
-5:s:= '未注冊成功';
-6: s:= '超出使用日期';
-7: s:= '費用不足';
-8: s:= '源手機錯誤';
-9: s:= '目的手機錯誤';
-10: s:= '信息內容錯誤';
-11: s:= '連接失敗';
-12: s:= '系統內部錯誤或者無效的客戶狀態';
-13: s:= '客戶權限不對';
-14: s:= '不是從指定的IP處登錄';
-15: s:= '帳號已經登錄(TCP)';
-16: s:= '內部通訊錯誤';
-17: s:= '無可用的MT通道';
-18: s:= '不支持該功能';
-19: s:= '未定義錯誤'; //-------------未定義錯誤
-20: s:= '未知錯誤';
else
s:= '未知錯誤';
end;
RED1.Lines.Add( s) ;
if num<>0 then red1.SelAttributes.Color := clred;
end;
procedure TForm1.RzBitBtn2Click(Sender: TObject);
var
strRegTime: array[0..20] of char;
strDenyTime: array[0..20] of char;
intType: Integer;
fPrice: Single;
fBalance: Single;
Stype: string;
begin
//判斷是否登陸
if (pRtnHandle = 0) or (OneHandle = 0) then begin
exit;
end;
try
JL_GetAccountRegTime(pRtnHandle, @strRegTime);
JL_GetAccountDenyTime(pRtnHandle, @strDenyTime);
JL_GetAccountType(pRtnHandle, @intType);
JL_GetAccountPrice(pRtnHandle, @fPrice);
JL_GetAccountBalance(pRtnHandle, @fBalance);
RED1.Lines.Add('注冊時間：' + strRegTime);
RED1.Lines.Add('截止時間：' + strDenyTime);
//intType 為 1 表示正式用戶 ； 2 表示用戶停用； 3為測試用戶
case intType of
1: Stype :='正式用戶';
2: Stype :='用戶停用';
else Stype :='測試用戶';
end;
RED1.Lines.Add('用戶類型：' + Stype);
RED1.Lines.Add('單價／條：' + formatfloat('0.00', fPrice) + '(元)');
RED1.Lines.Add('帳戶余額：' + formatfloat('0.00', fBalance) + '(元)');
except
on E: Exception do
begin
RED1.Lines.Add('系統嚴重錯誤，請重新登陸！!'+#13#10 + E.Message);
red1.SelAttributes.Color := clred;
end;
end;
end;
procedure TForm1.RzBitBtn4Click(Sender: TObject);
var
rtn: Integer;
CountWaitSend: Integer; //待發數量
CountTestSend: Integer; //測試發送的數量
begin
//判斷是否登陸
if (pRtnHandle = 0) or (OneHandle = 0) then begin
MessageBox(Handle, '你還沒有登陸!', 'Surge', MB_ICONASTERISK);
exit;
end;
try
//這里的rtn返回的是統計條數
rtn := JL_GetSendCount(pRtnHandle, //函數定義見Type部分。
PChar(Datetostr(DateTimePicker1.Date-1)),
PChar(Datetostr(DateTimePicker2.Date+1)),
@CountWaitSend, @CountTestSend);
// 如果返回值 < 0，則請參考錯誤返回值定義
if rtn < 0 then begin
ShowResultMsg(rtn);
exit;
end;
RED1.Lines.Add('從' + Datetostr(DateTimePicker1.Date) + '到' + Datetostr(DateTimePicker2.Date));
RED1.Lines.Add('實際發送總量為：' + inttostr(rtn) + '條');
RED1.Lines.Add('測試發送總量為：' + inttostr(CountTestSend) + '條');
RED1.Lines.Add('待發送總量為：' + inttostr(CountWaitSend) + '條');
except
on E: Exception do
begin
RED1.Lines.Add('系統嚴重錯誤，請重新登陸！!'+#13#10 + E.Message);
red1.SelAttributes.Color := clred;
end;
end;
end;
procedure TForm1.sendSms;
var
rtn,i: Integer;
begin
if (pRtnHandle = 0) or (OneHandle = 0) then
SetConnected(true);
if (pRtnHandle = 0) or (OneHandle = 0) then
exit ;
AdoQry.Close ;
AdoQry.SQL.Text :='select top 100 * from T_SMSSendList where isnull(S_Status,0)<>1 and ( DateDiff(second,cast (isnull(S_SendTime,Getdate()) as datetime ),Getdate())>80 or isnull(S_SendTime ,'''')='''')' ;
AdoQry.Open ;
if AdoQry.RecordCount >0 then
while not AdoQry.eof do
begin ;
try
rtn := JL_SendMsg(pRtnHandle, //函數定義見Type部分。
PChar(AdoQry.Fieldbyname('S_SendCardNo').asstring), //發送人手機號碼，可為空或是一個手機號碼
PChar(AdoQry.Fieldbyname('S_ReceiveCardNo').asstring), //群發時號碼用逗號分隔.例如: '13798416806,13798416806,13798416806'.
//群發號碼建議以分隔100條為一個單位。
PChar(AdoQry.Fieldbyname('S_SendContent').asstring), //短信內容是純英文字或數字長度不超過140個字
//若其中含有中文則英文字和數字同漢字一樣算一個字，長度不超過70個字。
''); //設定發送時間，為空則立即發送
if rtn=0 then
begin
ExecSql('Update T_SMSSendList set S_Status=1 ,S_updatetime=getdate() where ID='+AdoQry. Fieldbyname('id').asstring ) ;
RED1.Lines.Add('發送到' +AdoQry.Fieldbyname('S_ReceiveCardNo').asstring +' 成功');
end
else
ShowResultMsg(rtn);
except
on E: Exception do
RED1.Lines.Add('系統嚴重錯誤，請重新登陸！!'+#13#10 + E.Message);
end;
AdoQry.Next ;
end;
AdoQry.Close ;
end;
procedure TForm1.ReceiveSms;
var
LastMsgId,i,j: Integer;
pnMsgID: Integer;
strFrom: array[0..21] of char;
strCreateTime: array[0..20] of char;
strContent: array[0..255] of char;
s: string;
MaxMsgID :integer ;
begin
//判斷是否登陸
if (pRtnHandle = 0) or (OneHandle = 0) then
SetConnected(true);
if (pRtnHandle = 0) or (OneHandle = 0) then
exit ;
try
AdoQry.Close ;
AdoQry.SQL.Text :='Select MsgId= max(cast(isnull(S_Local,''0'') as int) )from T_SMSReceiveLog' ;
AdoQry.Open ;
maxMsgID := AdoQry.fieldbyname('MsgId').asinteger;
AdoQry.Close ;
LastMsgId := maxMsgID; //0表示收取所有上行信息
s := '';
while JL_ReceiveSM(pRtnHandle, LastMsgId) > 0 do
{//返回值大于0表示有上行信息，要讀取所有的需要循環發出請求，LastMsgId是循環變量，表示信息ID} begin
while JL_GetOneSM(pRtnHandle, @pnMsgID, @strFrom, @strCreateTime, @strContent) > 0 do {//信息是一條一條讀取的} begin
s := S+ ' insert into T_SMSReceiveLog (S_UPdatetime,S_Status,S_Local,S_SendCardNo,S_Content,S_SMSTime)'
+ ' Values(getdate(),''0'','' ' + inttostr(pnMsgID) +''','''+strFrom+''',''' + strContent+ ''',''' + strCreateTime+''') '+ chr(13);
RED1.Lines.Add('MsgID:' + inttostr(pnMsgID) + ' From:' + strFrom + ' CreateTime:' + strCreateTime + ' InFo：' + strContent);
getContent(strFrom, strContent);
end;
LastMsgId := pnMsgID;
end;
if s<>'' then
begin
ExecSql(s) ;
end;
except
on E: Exception do
begin
RED1.Lines.Add('系統嚴重錯誤，請重新登陸！!'+#13#10 + E.Message);
red1.SelAttributes.Color := clred;
end;
end;
end;
procedure TForm1.TimerShowTimer(Sender: TObject);
begin
if tag=9 then exit;
TimerShow.Enabled := false;
tag := 9 ;
sendSms;
ReceiveSms;
tag := 0 ;
TimerShow.Enabled := true;
end;
procedure TForm1.RzBitBtn1Click(Sender: TObject);
begin
if (pRtnHandle = 0) or (OneHandle = 0) then
SetConnected(true)
else
RED1.Lines.Add('正常');
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
DateTimePicker2.DateTime := date-1;
DateTimePicker2.DateTime := date +1;
TimerShow.Enabled := true;
end;
procedure TForm1.ExecSQL(s :string);
var i :integer;
begin
ADOConnObject.Execute(s,i)
end;
procedure TForm1.OpenSQL(s :string);
var i :integer;
begin
AdoQry.close;
AdoQry.sql.text := s;
AdoQry.open ;
end ;
procedure TForm1.getContent(AstrFrom:string;AstrContent:string) ;
var Acancel,Fkey :integer;
fUser ,str,s:string;
begin
try
if ( pos('SP', Uppercase(AstrContent))>0 ) and
( (pos('Y', Uppercase(AstrContent))>0 ) or ( pos('N', Uppercase(AstrContent))>0) ) then
begin
if pos('N', Uppercase(AstrContent))>0 then
Acancel :=1
else
if pos('Y', Uppercase(AstrContent))>0 then
Acancel :=0
else
exit ;
str :=leftstr(AstrContent, pos('SP', Uppercase(AstrContent))-1) ;
if str='' then
exit;
Fkey :=strtoint(str);
s := 'select top 1 U.FuserName from userinfo U ,ck_flow_step S ,ck_flow_task T '
+' where CharIndex(U.FUserCode, S.FCheckers) > 0 '
+' and S.FstepId =FNextStep and FTaskId= '+str+' and isnull(Fphone,'''')= '+cp(AstrFrom);
openSql(s) ;
// openSql('select top 1 U.FuserName from userinfo U where isnull(Fphone,'''')= '+cp(AstrFrom));
if not AdoQry.IsEmpty then
fUser:= AdoQry.fieldbyname('FuserName') .asstring
else
exit;
CkFlow( Fkey,fUser ,Acancel,'短信審批');
end;
except
on E: Exception do
begin
RED1.Lines.Add(AstrFrom+'發的:'+AstrContent +'，格式有誤,不能解析審批' +#13#10 + E.Message);
red1.SelAttributes.Color := clred;
exit ;
end;
end;
end;
procedure TForm1.CkFlow(AKey: Variant; AUser: string;
FCancel:integer;Fnote:string);
var
FCDS1, FCDS2: TClientDataset;
FSteps: TStrings;
s, snote: string;
AID, n, AFlowID, AStepID, ANextStep, ATaskID, ACancel: integer;
procedure _DoConfirm;
var
ss, ss1, ASts: string;
nn, ADraftKey: integer;
begin
ADraftKey := FCDS1.FieldByName('FDocKey').Asinteger;
nn := FSteps.IndexOf(inttostr(AStepID));
if nn = FSteps.Count - 1 then
begin
ANextStep := -1;
ASts := 'C';
ss1 := Format(' Update %s ..odrf Set U_CheckMan = %s Where DocEntry = %d',
[EdSboDb.Text,cp('Y'), ADraftKey]);
end
else
begin
ANextStep := strtoint(FSteps[nn + 1]);
ASts := 'O';
ss1 := '';
end;
ss := Format('Update %s Set FNextStep = %d, FStatus = %s Where FTaskID = %d',
['ck_flow_task', ANextStep, cp(ASts), AID]);
ss := ss+ ForMat(' exec [CK_Flow_Sms] %d,%d,%s' ,
[ FCDS1.FieldByName('objtype').asinteger,AID,cp(EdSboDb.Text )] ) ;
ExecSQL(ss + ss1);
end;
procedure _DoCancel;
var
ss, ss2: string;
nn, ADraftKey: integer;
begin
ADraftKey := FCDS1.FieldByName('FDocKey').Asinteger;
ss := Format('Update %s Set FNextStep = -1, FStatus = %s, FCanceled = %s Where FTaskID = %d',
[('ck_flow_task'), cp('C'), cp('Y'), AID]);
ss2 := Format(' Update odrf Set U_CheckMan = %s Where DocEntry = %d',
[cp('C'), ADraftKey]);
ExecSQL(ss + ss2);
end;
begin
FCDS1 := TClientDataset.Create(nil);
FCDS2 := TClientDataset.Create(nil);
FSteps := TStringList.Create;
AID := AKey;
ACancel := FCancel;
snote := Fnote;
s := Format('Select * From %s Where FTaskID = %d',
['ck_flow_task', AID]);
OpenSQL(s);
if AdoQry.IsEmpty then
begin
RED1.Lines.Add('找不到審批任務，ID: ' + inttostr(AID));
red1.SelAttributes.Color := clred;
exit ;
end;
FCDS1.Data := DatasetToCdsData(AdoQry);
AFlowID := FCDS1.FieldByName('FCheckFlowID').AsInteger;
AStepID := FCDS1.FieldByName('FNextStep').AsInteger;
s := Format('Select * From %s Where FID = %d', ['ck_flow', AFlowID]);
OpenSQL(s);
if AdoQry.IsEmpty then
begin
RED1.Lines.Add('找不到審批流程，ID: ' + inttostr(AFlowID));
red1.SelAttributes.Color := clred;
exit ;
end;
FCDS2.Data := DatasetToCdsData(AdoQry);
FSteps.Delimiter := ',';
FSteps.DelimitedText := FCDS2.FieldByName('FCheckSteps').AsString;
s := Format('Insert %s(FTaskID, FStepID, FCheckMan, FDate, FNote) ' +
' Values (%d, %d, %s, %s, %s) ', ['ck_flow_dt',
AID, AStepID, cp(AUser),
cp(DateToStr(Date)), cp(snote)]);
ADOConnObject.BeginTrans;
try
execsql(s);
if ACancel = 1 then
_DoCancel
else
_DoConfirm;
ADOConnObject.CommitTrans;
except
on e: Exception do
begin
ADOConnObject.RollbackTrans;
begin
RED1.Lines.add('錯誤：'+e.Message);
red1.SelAttributes.Color := clred;
end;
end;
end;
FCDS1.Free;
FCDS2.Free;
FSteps.Free;
end;
end.
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -