📄 main_f.pas
字号:
unit Main_F;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, DialUp, ComCtrls, ExtCtrls, Psock, NMFtp, DB, ADODB, Buttons;
type
Tdfmdial = class(TForm)
DialUp: TDialUp;
Panel1: TPanel;
Label1: TLabel;
Status2: TLabel;
StatusBar1: TStatusBar;
Panel2: TPanel;
Button2: TButton;
Button3: TButton;
ComboBox1: TComboBox;
Panel3: TPanel;
Panel4: TPanel;
Label2: TLabel;
DateTimePicker1: TDateTimePicker;
Label3: TLabel;
DateTimePicker2: TDateTimePicker;
NMFTP1: TNMFTP;
GroupBox1: TGroupBox;
Memo1: TMemo;
GroupBox2: TGroupBox;
Memo2: TMemo;
atbldefault: TADOTable;
Memo3: TMemo;
atbltrans: TADOTable;
Label4: TLabel;
ComboBox2: TComboBox;
ADOQuery1: TADOQuery;
BitBtn1: TBitBtn;
procedure Button2Click(Sender: TObject);
procedure DialUpEntryGet(Sender: TObject; EntryName: array of Char);
procedure Button3Click(Sender: TObject);
procedure DialUpConnect(Sender: TObject);
procedure DialUpError(Sender: TObject; ErrorCode: Integer;
ErrorMessage: String);
procedure DialUpDialing(Sender: TObject);
procedure DialUpNotConnected(Sender: TObject; ErrorCode: Integer;
ErrorMessage: String);
procedure DialUpAsyncEvent(Sender: TObject; State, Error: Integer;
MessageText: String);
procedure Button4Click(Sender: TObject);
procedure DialUpActiveConnection(Sender: TObject; Handle: Integer;
Status: TRasConnStatusA; StatusString: String; EntryName, DeviceType,
DeviceName: array of Char);
procedure Button5Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure NMFTP1ListItem(Listing: String);
procedure transfile;
procedure addfiles;
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormShow(Sender: TObject);
procedure creatsale;
procedure BitBtn1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
dfmdial: Tdfmdial;
fst:string;
slen:integer;
vbmh,vras,vhost,vuser,vpwd,vftpup,vftpdown:string;
vport,vtimeout:integer;
implementation
uses dbmRainbowMis, dfm_receive;
{$R *.DFM}
procedure Tdfmdial.Button2Click(Sender: TObject);
begin
if ComboBox1.Items.Count=0 then
begin
ShowMessage('请首先选择一个连接!');
Exit;
end;
DialUp.DialMode:=dmSync;
DialUp.Entry:=ComboBox1.Items[ComboBox1.ItemIndex];
DialUp.Dial;
end;
procedure Tdfmdial.DialUpEntryGet(Sender: TObject; EntryName: array of Char);
begin
ComboBox1.Items.Add(PChar(@EntryName[0]));
ComboBox1.ItemIndex:=0;
end;
procedure Tdfmdial.Button3Click(Sender: TObject);
begin
DialUp.HangUp;
end;
procedure Tdfmdial.DialUpConnect(Sender: TObject);
begin
Status2.Caption:='已连接!';
transfile;
end;
procedure Tdfmdial.DialUpError(Sender: TObject; ErrorCode: Integer;
ErrorMessage: String);
begin
Status2.Caption:='错误!';
end;
procedure Tdfmdial.DialUpDialing(Sender: TObject);
begin
Status2.Caption:='正在拔号...'; Application.ProcessMessages;
end;
procedure Tdfmdial.DialUpNotConnected(Sender: TObject; ErrorCode: Integer;
ErrorMessage: String);
begin
Status2.Caption:='没有连接!';
end;
procedure Tdfmdial.DialUpAsyncEvent(Sender: TObject; State, Error: Integer;
MessageText: String);
begin
// Status.Caption:=MessageText;
if Error<>0 then Status2.Caption:='错误. 清挂断重拔.';
end;
procedure Tdfmdial.Button4Click(Sender: TObject);
begin
ComboBox1.Clear; Button2.Enabled:=False;
DialUp.GetConnections;
end;
procedure Tdfmdial.DialUpActiveConnection(Sender: TObject; Handle: Integer;
Status: TRasConnStatusA; StatusString: String; EntryName, DeviceType,
DeviceName: array of Char);
begin
ComboBox1.Items.Add(EntryName+' | '+DeviceName+' || '+StatusString);
//if CheckBox1.Checked then DialUp.HangUpConn(Handle);
end;
procedure Tdfmdial.Button5Click(Sender: TObject);
begin
DialUp.HangUpConn(ComboBox1.ItemIndex);
end;
procedure Tdfmdial.FormCreate(Sender: TObject);
begin
atbltrans.Open;
atbldefault.Active :=true;
fst := ExtractFilePath(Application.ExeName); // 取出路径
vbmh:=trim(atbltrans['cbmh']);
vhost:=trim(atbltrans['cip']);
vras:=trim(atbltrans['cradial']);
vuser:=trim(atbltrans['cuserid']);
vpwd:=trim(atbltrans['cpassword']);
vftpup:=trim(atbltrans['cftpup']);
vftpdown:=trim(atbltrans['cftpdown']);
vport:=atbltrans['cport'];
vtimeout:=atbltrans['ctimeout'];
// scode:=trim(atbldefault['cbmh']);
slen:=length(vbmh);
DateTimePicker1.Date:=date();
DateTimePicker2.Date:=date();
ComboBox1.Clear;
ComboBox2.text:=atbldefault['clabel'];
Button2.Enabled:=True;
DialUp.GetEntries;
end;
procedure Tdfmdial.NMFTP1ListItem(Listing: String);
begin
Memo2.Lines.Add(Listing);
end;
procedure Tdfmdial.transfile;
var
I:integer;
m:integer;
begin
Status2.Caption:='开始文件传输!';
memo2.Clear;
memo3.Clear;
NMFTP1.Host := vhost;
NMFTP1.Port := vport;
NMFTP1.Timeout := vtimeout;
NMFTP1.UserID := vuser;
NMFTP1.Password := vpwd;
try
NMFTP1.connect;
except
On E:Exception do
writeln(E.message);
end;
{上传要发送的文件列表}
for I := 0 to memo1.lines.Count - 1 do
begin
nmftp1.ChangeDir(vftpup);
try NMFTP1.Upload(memo1.lines[I],ExtractFileName(memo1.lines[I])); except end;
Deletefile(pchar(memo1.lines[I]));
end;
nmftp1.ChangeDir(vftpdown);
try nmftp1.Nlist; except end;
for m := 0 to memo2.lines.Count - 1 do
begin
{下载文件}
if copy(memo2.lines[m],0,slen)=vbmh then
begin
try NMFTP1.Download(memo2.lines[m],fst+'datain\'+memo2.lines[m]); except end;
NMFTP1.Delete(memo2.lines[m]); {下载后删除文件}
memo3.Lines.Add(memo2.lines[m]);
end;
if copy(memo2.lines[m],0,2)='fl' then
begin
try NMFTP1.Download(memo2.lines[m],fst+'datain\'+memo2.lines[m]); except end;
memo3.Lines.Add(memo2.lines[m]);
end;
if copy(memo2.lines[m],0,2)='sp' then
begin
try NMFTP1.Download(memo2.lines[m],fst+'datain\'+memo2.lines[m]); except end;
memo3.Lines.Add(memo2.lines[m]);
end;
if copy(memo2.lines[m],0,2)='tz' then
begin
try NMFTP1.Download(memo2.lines[m],fst+'datain\'+memo2.lines[m]); except end;
memo3.Lines.Add(memo2.lines[m]);
end;
end;
DialUp.HangUp;
if Application.MessageBox('数据已经传输完毕,请立即进行接收处理!','提示信息',MB_OK)=IDOK then
begin
If Application.FindComponent('dfmreceive')=Nil Then
dfmreceive:=Tdfmreceive.Create(Application);
dfmreceive.Show;
end;
close;
end;
procedure Tdfmdial.addfiles;
var
sr: TSearchRec;
FileAttrs: Integer;
begin
FileAttrs := faArchive;
//faAnyFile;
//faDirectory;
with memo1 do
begin
Clear;
if FindFirst(fst+'dataout\*.*', FileAttrs, sr) = 0 then
begin
repeat
if (sr.Attr and FileAttrs) = sr.Attr then
begin
memo1.Lines.Add(fst+'dataout\'+sr.Name)
// Cells[1,RowCount-1] := sr.Name;
end;
until FindNext(sr) <> 0;
FindClose(sr);
end;
end;
// transfile;
end;
procedure Tdfmdial.FormClose(Sender: TObject; var Action: TCloseAction);
begin
atbltrans.close;
atbldefault.Active :=false;
action:=cafree;
end;
procedure Tdfmdial.FormShow(Sender: TObject);
begin
addfiles;
end;
procedure Tdfmdial.creatsale;
var
fstr:string;
begin
fstr:='SELECT ''%s'' as bmh, rq, spbh, sum(t_saledet.sl) as sl, round(avg(t_saledet.lsj)) as lsj, sum(t_saledet.sjje) as sjje, sum(t_saledet.zke) as zke, clabel FROM t_saledet'
+' where clabel like ''%s'' and rq>=#%s# and rq<=#%s#'
+' GROUP BY rq, clabel, spbh'
+' order by rq, clabel, spbh';
with ADOQuery1 do
begin
close;
sql.Clear ;
sql.Add(Format(fstr,[trim(atbltrans['cbmh']),trim(comboBox2.text)+'%',datetostr(DateTimePicker1.Date),datetostr(DateTimePicker2.Date)]));
Prepared;
open;
end;
ADOQuery1.SaveToFile(fst+'dataout\'+trim(atbltrans['cbmh'])+'xs'+formatdatetime('mmdd',DateTimePicker1.Date)+formatdatetime('mmdd',DateTimePicker2.Date)+'.dtg');
end;
procedure Tdfmdial.BitBtn1Click(Sender: TObject);
begin
creatsale;
addfiles;
end;
end.
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -