📄 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
RED1.Lines.Add( '你还没有登陆!');
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 + -