⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 main_f.pas

📁 仓库管理系统 仓库管理系统
💻 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 + -