📄 unit1.pas
字号:
comSource[itmp].Tag:=itarget; //Marker TargetPort ID
comSource[itmp].Name:=stmp;
NullTest:=rece.Fields['Address'].value;
if (NullTest <>null) and (trim(NullTest) <>'') then comSource[itmp].ComPath:=NullTest else bValid:=false;
NullTest:=rece.Fields['interval'].value;
if NullTest <>null then if bValid then SetTimer(application.handle,isource,NullTest*60000,nil);
end;
end;
end;
end;
rece.close;
end;
end;
if itarget>-1 then
begin
stmp:='Send'+inttostr(itarget);
if FindComponent(stmp)=nil then //if no exist then Create TargetPort instance
begin
rece.open('select * from port where id='+inttostr(itarget),adoobj,1);
if rece.recordcount>0 then
begin
NullTest:=rece.Fields['Protocol'].value;
if NullTest<>Null then
begin
bValid:=true; //If Obj.Tag is -1 then obj property Initialize fail
case NullTest of
1: //Create TCP/Send
begin
itmp:=high(TCPClient)+1;
SetLength(TCPClient,itmp+1);
TCPClient[itmp]:=TClientSocket.Create(self);
TCPClient[itmp].OnError:=TCPServerClientError;
TCPClient[itmp].Tag:=1; //protocol type ID
TCPClient[itmp].Name:=stmp;
NullTest:=rece.Fields['Address'].value;
if (NullTest <>null) and (trim(NullTest)<>'') then TCPClient[itmp].Host:=NullTest else bValid:=false;
NullTest:=rece.Fields['Port'].value;
if (NullTest <>null) and (NullTest <>0) then TCPClient[itmp].Port:=NullTest else bValid:=false;
// try
// if bValid then TCPClient[itmp].Active:=true else TCPClient[itmp].Tag:=-1;
// except
// end;
if not bValid then TCPClient[itmp].Tag:=-1;
end;
3: //Create SMTP/Send
begin
itmp:=high(SMTPTarget)+1;
SetLength(SMTPTarget,itmp+1);
SMTPTarget[itmp]:=TIdSMTP.Create(self);
SMTPTarget[itmp].Name:=stmp;
SMTPTarget[itmp].Tag:=3;
NullTest:=rece.Fields['Address'].value;
if (NullTest <>null) and (trim(NullTest)<>'') then SMTPTarget[itmp].Host :=NullTest else bValid:=false;
NullTest:=rece.Fields['Port'].value;
if NullTest <>null then (if NullTest<>0 then SMTPTarget[itmp].Port :=NullTest) else bValid:=false;
NullTest:=rece.Fields['user'].value;
if NullTest <>null then SMTPTarget[itmp].UserId :=NullTest else bValid:=false;
NullTest:=rece.Fields['password'].value;
if NullTest <>null then SMTPTarget[itmp].Password :=NullTest else bValid:=false;
NullTest:=rece.Fields['Reserve'].value;
if NullTest <>null then SMTPTarget[itmp].SocksInfo.Host :=NullTest else bValid:=false;
NullTest:=rece.Fields['Description'].value;
if NullTest <>null then SMTPTarget[itmp].SocksInfo.Password :=NullTest else bValid:=false;
SMTPTarget[itmp].MailAgent:='Linnet Transceiver 1.0';
SMTPTarget[itmp].AuthenticationType:= atLogin;
if not bValid then HTTPClient[itmp].Tag:=-1;
end;
5: //Create FTP/Send
begin
itmp:=high(FTPTarget)+1;
SetLength(FTPTarget,itmp+1);
FTPTarget[itmp]:=TIdFTP.Create(self);
FTPTarget[itmp].Name:=stmp;
FTPTarget[itmp].tag:=5;
NullTest:=rece.Fields['Address'].value;
if (NullTest <>null) and (trim(NullTest) <>'') then FTPTarget[itmp].Host:=NullTest else bValid:=false;
NullTest:=rece.Fields['Port'].value;
if NullTest <>null then (if NullTest<>0 then FTPTarget[itmp].Port:=NullTest) else bValid:=false;
NullTest:=rece.Fields['user'].value;
if NullTest <>null then if trim(NullTest)='' then FTPTarget[itmp].User:='anonymous' else FTPTarget[itmp].User :=NullTest else bValid:=false;
NullTest:=rece.Fields['password'].value;
if NullTest <>null then if trim(NullTest)='' then FTPTarget[itmp].Password :='Transceiver@Linnet.com' else FTPTarget[itmp].Password :=NullTest else bValid:=false;
NullTest:=rece.Fields['Description'].value;
stmp:='';
if NullTest <>null then stmp :=trim(NullTest) else bValid:=false;
if stmp<>'' then
begin
ibit:=pos('.',stmp);
if ibit>0 then
begin
sbit:=copy(stmp,1,ibit-1);
stmp:=copy(stmp,ibit+1,255);
if pos('*',sbit)=0 then FTPTarget[itmp].SocksInfo.Password:=sbit else FTPTarget[itmp].SocksInfo.Password:=copy(sbit,1, pos('*',sbit)-1);
if pos('*',stmp)=0 then FTPTarget[itmp].SocksInfo.UserID:=stmp else FTPTarget[itmp].SocksInfo.UserID:=copy(stmp,1, pos('*',stmp)-1);
end
else if pos('*',stmp)=0 then FTPTarget[itmp].SocksInfo.Password:=stmp else FTPTarget[itmp].SocksInfo.Password:=copy(stmp,1, pos('*',stmp)-1);
end;
NullTest:=rece.Fields['Reserve'].value;
if NullTest <>null then
begin
stmp:=NullTest;
if trim(stmp)='' then stmp:='/'
else
begin
if pos('/',stmp)<pos('\',stmp) then sbit:='\' else sbit:='/';
if stmp[1]<>sbit then NullTest:=sbit+NullTest;
if stmp[length(stmp)]<>sbit then NullTest:=NullTest+sbit;
end;
end else bValid:=false;
if bValid then FTPTarget[itmp].SocksInfo.Host:=NullTest else FTPTarget[itmp].Tag:=-1;
end;
7: //Create HTTP/Send
begin //SocksInfo.Host is WebSite, SocksInfo.password is request
itmp:=high(HTTPClient)+1;
SetLength(HTTPClient,itmp+1);
HTTPClient[itmp]:=TIdHTTP.Create(self);
HTTPClient[itmp].Name:=stmp;
HTTPClient[itmp].tag:=7;
NullTest:=rece.Fields['Address'].value;
if (NullTest <>null) and (trim(NullTest) <>'') then stmp:=NullTest else bValid:=false;
NullTest:=rece.Fields['Port'].value;
if (NullTest <>null) and (NullTest<>0) and (NullTest<>80) then sbit:=inttostr(NullTest) else sbit:='';
if bValid and (sbit<>'') then
begin
ibit:=pos('/',copy(stmp,9,512));
Insert(':'+sbit,stmp,ibit+8);
end;
HTTPClient[itmp].SocksInfo.Host:=stmp;
HTTPClient[itmp].Request.ContentType:='application/x-www-form-urlencoded';
if not bValid then HTTPClient[itmp].Tag:=-1;
NullTest:=rece.Fields['Reserve'].value;
if (NullTest <>null) and (trim(NullTest)<>'') then HTTPClient[itmp].SocksInfo.password:=NullTest+'=';
end;
9: //Create File/Send
begin
itmp:=high(fileTarget)+1;
SetLength(fileTarget,itmp+1);
fileTarget[itmp]:=TFileFace.Create(self);
fileTarget[itmp].Name:=stmp;
fileTarget[itmp].tag:=9;
NullTest:=rece.Fields['Address'].value;
if (NullTest <>null) and (trim(NullTest) <>'') then
begin
if DirectoryExists(NullTest) then if copy(NullTest,length(NullTest),1)='\' then NullTest:=NullTest+'*.*' else NullTest:=NullTest+'\*.*';
stmp:=ExtractFilePath(NullTest);
if stmp[length(stmp)]<>'\' then stmp:=stmp+'\';
if not DirectoryExists(stmp) then if not ForceDirectories(stmp) then bValid:=false;
end
else bValid:=false;
if bValid then fileTarget[itmp].FilePath:=stmp else fileTarget[itmp].Tag:=-1;
stmp:=trim(ExtractFilename(NullTest));
if length(stmp)>0 then
begin
ibit:=pos('.',stmp);
if ibit>0 then
begin
sbit:=copy(stmp,1,ibit-1);
stmp:=copy(stmp,ibit+1,255);
if pos('*',sbit)=0 then fileTarget[itmp].Prefix:=sbit else fileTarget[itmp].Prefix:=copy(sbit,1, pos('*',sbit)-1);
if pos('*',stmp)=0 then fileTarget[itmp].suffix:=stmp else fileTarget[itmp].suffix:=copy(stmp,1, pos('*',stmp)-1);
end
else if pos('*',stmp)=0 then fileTarget[itmp].Prefix:=stmp else fileTarget[itmp].Prefix:=copy(stmp,1, pos('*',stmp)-1);
end;
end;
11: //Create MSMQ/Send
begin
itmp:=high(msmqTarget)+1;
SetLength(msmqTarget,itmp+1);
msmqTarget[itmp]:=TMSMQFace.Create(self);
msmqTarget[itmp].Name:=stmp;
msmqTarget[itmp].tag:=11;
NullTest:=rece.Fields['Address'].value;
if (NullTest <>null) and (trim(NullTest)<>'') then msmqTarget[itmp].MSMQPath:=NullTest else msmqTarget[itmp].Tag:=-1;
end;
13: //Create DB/Send
begin
itmp:=high(dbTarget)+1;
SetLength(dbTarget,itmp+1);
dbTarget[itmp]:=TDBFace.Create(self);
dbTarget[itmp].Name:=stmp;
dbTarget[itmp].tag:=13;
NullTest:=rece.Fields['Address'].value;
if (NullTest <>null) and (trim(NullTest)<>'') then dbTarget[itmp].DBPath:=NullTest else bValid:=false;
NullTest:=rece.Fields['Reserve'].value;
if NullTest <>null then dbTarget[itmp].SQL:=NullTest else bValid:=false;
if not bValid then dbTarget[itmp].Tag:=-1;
end;
15: //Create COM/Send
begin
itmp:=high(comTarget)+1;
SetLength(comTarget,itmp+1);
comTarget[itmp]:=TCOMFace.Create(self);
comTarget[itmp].Name:=stmp;
comTarget[itmp].Tag:=15;
NullTest:=rece.Fields['Address'].value;
if (NullTest <>null) and (trim(NullTest)<>'') then comTarget[itmp].ComPath:=NullTest else comTarget[itmp].Tag:=-1;
end;
end;
end;
end;
rece.close;
end;
end;
recd.movenext;
end;
recd.close;
ADOOBJ.Close;
recd := Unassigned;
rece:=Unassigned;
ADOOBJ:=Unassigned;
application.OnMessage:=Timer;
itmp:=-1;
if regval.QueueType<>'None' then SetTimer(application.handle,itmp,Round(StrToFloat(regval.QueueInterval)*60000),nil);
if regval.LogType='DB' then
begin
itmp:=-2;
SetTimer(application.handle,itmp,3600000,nil);
postmessage(application.handle,WM_TIMER,-2,0);
end;
end;
Procedure TCarrier.Timer(var Msg: TMsg; var Handled: Boolean);
var ADOOBJ,recd,ADOLog:OleVariant;
itmp,iretry,iID:integer;
NullTest:Variant;
stime,stmp:string;
Obj:TComponent;
begin
if Msg.message <>WM_TIMER then exit;
case msg.WParam of
-1: //is Queue Timer
begin
ADOOBJ:=CreateOleObject('ADODB.Connection');
ADOLog:=CreateOleObject('ADODB.Connection');
recd:=CreateOleObject('adodb.recordset');
ADOOBJ.Open(regval.QueueDB);
ADOLog.Open(regval.LogDB);
recd.open('data',adoobj,1,3);
while not recd.eof do
begin
NullTest:=recd.Fields['PortID'].value;
if NullTest =Null then recd.Fields['state']:=3
else
begin
itmp:=NullTest;
NullTest:=recd.Fields['Retry'].value;
if NullTest =Null then iretry:=1 else iretry:=NullTest+1;
NullTest:=recd.Fields['Data'].value;
iID:=recd.Fields['LogID'].value;
sTime:= datetimetostr(now);
if DataSend(NullTest,itmp) then
begin
recd.Fields['state']:=1;
recd.update;
if iID<>-1 then ADOLog.Execute('update log set SendTime='''+sTime+''',State=1,retry='+inttostr(iretry)+' where ID='+inttostr(iID));
end
else
begin
if iretry<strtoint(regval.QueueRetryCount) then
begin
recd.Fields['Retry']:=iretry;
recd.Fields['Stamp']:=sTime;
recd.update;
if iID<>-1 then ADOLog.Execute('update log set CacheTime='''+sTime+''',retry='+inttostr(iretry)+' where ID='+inttostr(iID));
end
else
begin
recd.Fields['state']:=3;
recd.update;
if iID<>-1 then ADOLog.Execute('update log set CacheTime='''+sTime+''',state=3,retry='+inttostr(iretry)+' where ID='+inttostr(iID));
end;
end;
end;
recd.movenext;
end;
// itmp:=recd.recordcount;
ADOOBJ.Execute('DELETE from data where state=1 or state=3');
recd.close;
ADOOBJ.Close;
ADOLog.Close;
ADOLog:=Unassigned;
recd := Unassigned;
ADOOBJ:=Unassigned;
// if itmp>0 then sendMessage(findwindow('Tfrmcfg',nil),WM_User+$1011,0,0);
end;
-2: //is db DBClear Timer
begin
ADOOBJ:=CreateOleObject('ADODB.Connection');
recd:=CreateOleObject('adodb.recordset');
ADOOBJ.Open(regval.LogDB);
recd.open('Select Count(*) as Counts from log',adoobj,1,3);
itmp:=recd.Fields['Counts'].value;
recd.close;
if itmp>strtoint(regval.LogCount) then
ADOOBJ.Execute('DELETE from log WHERE ID IN(Select Top '+inttostr(itmp-strtoint(regval.LogCount))+' ID from Log)');
ADOOBJ.Close;
recd:=Unassigned;
ADOOBJ:=Unassigned;
end;
else //is object interval triger Timer
begin
Obj:=FindComponent('Receive'+inttostr(msg.WParam));
if obj=nil then exit;
stmp:=obj.ClassName;
if stmp='TIdPOP3' then GetPOP3(TIdPOP3(Obj));
if stmp='TIdFTP' then GetFTP(TIdFTP(obj));
if stmp='TIdHTTP' then GetHTTP(TIdHTTP(obj));
if stmp='TFileFace' then GetFile(TFileFace(Obj));
if stmp='TMSMQFace' then GetMSMQ(TMSMQFace(Obj));
if stmp='TCOMFace' then GetCOM(TCOMFace(Obj));
if stmp='TDBFace' then GetDB(TDBFace(Obj));
end;
end;//case end
end;
Procedure TCarrier.GetFTP(FTPOBJ:TIdFTP);
var sitem:TStrings;
itmp:integer;
FileStream: TStringStream;
begin
sitem:=TStringlist.Create;
FileStream := TStringStream.Create('');
try
if not FTPOBJ.Connected then FTPOBJ.Connect;
try
FTPOBJ.ChangeDir(FTPOBJ.SocksInfo.Host);
FTPOBJ.List(sitem,FTPOBJ.SocksInfo.Password,false);
for itmp:=0 to sitem.Count-1 do
begin
FTPOBJ.Get(sitem[itmp],FileStream);
FTPOBJ.Delete(sitem[itmp]);
DataArrive(FileStream.DataString,FTPOBJ.Tag);
end;
except
end;
FTPOBJ.Disconnect;
except
FTPOBJ.Disconnect;
end;
sitem.Free;
FileStream.Free;
end;
procedure TCarrier.GetPOP3(POP3Obj:TIdPOP3);
var itmp,ival:integer;
Msg:TIdMessage;
begin
Msg:=TIdMessage.Create(self);
try
if not POP3Obj.Connected then POP3Obj.Connect;
try
for itmp:=1 to POP3Obj.CheckMessages do
begin
Msg.Clear;
try
POP3Obj.RetrieveHeader(itmp,Msg);
if POP3Obj.SocksInfo.Password<>'' then if trim(msg.Subject)<>POP3Obj.SocksInfo.Password then continue;
POP3Obj.Retrieve(itmp,Msg);
for ival := 0 to Msg.MessageParts.Count-1 do if Msg.MessageParts.Items[ival] is TIdText then break;
DataArrive(TIdText(Msg.MessageParts.Items[ival]).Body.Text,POP3Obj.Tag);
POP3Obj.Delete(itmp);
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -