dfm_receive.pas

仓库管理系统 仓库管理系统

unit dfm_receive;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls, DB, Grids, DBGrids, ADODB, StdCtrls, ExtCtrls, Buttons,
  DBGridEh;

type
  Tdfmreceive = class(TForm)
    StatusBar1: TStatusBar;
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    TabSheet2: TTabSheet;
    Panel1: TPanel;
    RichEdit1: TRichEdit;
    BitBtn1: TBitBtn;
    ADOTable1: TADOTable;
    DataSource1: TDataSource;
    ADOQuery1: TADOQuery;
    GroupBox1: TGroupBox;
    Memo1: TMemo;
    ADOQuery2: TADOQuery;
    Panel2: TPanel;
    BitBtn2: TBitBtn;
    GroupBox2: TGroupBox;
    Memo2: TMemo;
    ADOTable2: TADOTable;
    ADOQuery3: TADOQuery;
    ADOQuery4: TADOQuery;
    DBGrid2: TDBGrid;
    ADOTable3: TADOTable;
    ADOQuery5: TADOQuery;
    ADOTable4: TADOTable;
    DataSource2: TDataSource;
    DBGridEh1: TDBGridEh;
    Label1: TLabel;
    DateTimePicker1: TDateTimePicker;
    Label2: TLabel;
    Label3: TLabel;
    Atblstoin: TADOTable;
    ADOQuery6: TADOQuery;
    ADOQuery7: TADOQuery;
    TabSheet3: TTabSheet;
    GroupBox3: TGroupBox;
    Memo3: TMemo;
    GroupBox4: TGroupBox;
    richedit2: TRichEdit;
    atblprice: TADOTable;
    ADOQuery8: TADOQuery;
    ADOQuery9: TADOQuery;
    TabSheet4: TTabSheet;
    atblslday: TADOTable;
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    Function Regulatestr(aString,Sepchar:string):string;
    Function GetSubStr(var aString:string;SepChar:String):String;
    Function GetSubStrNum(aString:string;SepChar:String ):Integer;
    procedure FormCreate(Sender: TObject);
    procedure addtemp(atbltemp:Tadotable);
    procedure addfile;
    function memosel(vmemo:Tmemo;Index:integer):boolean;
    procedure Memo2Click(Sender: TObject);
    procedure sumno;
    procedure BitBtn2Click(Sender: TObject);
    procedure Memo3Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  dfmreceive: Tdfmreceive;
  fst,vstr,a:string;
  LineNum:longint;
  vlen:integer;
  Const Space=#9;

implementation

uses dbmRainbowMis, chHeadUnit;

{$R *.dfm}

procedure Tdfmreceive.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  adotable3.close;
  action:=cafree;
end;

function Tdfmreceive.GetSubStr(var aString: string;
  SepChar: String): String;
var
  Mystr:String;
//  StrLen:Integer;
  SepCharPos:Integer;
begin
//  StrLen:=Length(aString);
  SepCharPos:=Pos(SepChar,aString);
  if sepcharpos=0 then
    MyStr:=trim(aString)
  else
    MyStr:=Copy(aString,1,SepCharPos-1);
  Delete(aString,1,SepCharPos);
  GetSubStr:=MyStr;
end;

function Tdfmreceive.GetSubStrNum(aString, SepChar: String): Integer;
var
  i:Integer;
  StrLen:Integer;
  Num:Integer;
begin
  StrLen:=Length(aString);
  Num:=0;
  for i:=1 to StrLen do
  begin
    if Copy(aString,i,1)=SepChar then
      Num:=Num+1;
      GetSubStrNum:=Num;
  end;
end;

function Tdfmreceive.Regulatestr(aString, Sepchar: string): string;
var
  i,Num:Integer;
  Flag:Boolean;
  MyStr,TempStr:String;
begin
  astring:=trim(astring);
  Flag:=False;
  Num:=Length(aString);
  for i:=1 to Num do
  begin
    TempStr:=Copy(aString,i,1);
    if (TempStr=SepChar) then
      if flag=false then
      begin
        MyStr:=MyStr+TempStr;
        Flag:=True;
      end ;
    if (TempStr<>SepChar) then
    begin
      Mystr:=Mystr+TempStr;
      Flag:=False;
    end;
  end;
  RegulateStr:=mystr;
end;

procedure Tdfmreceive.FormCreate(Sender: TObject);
begin
  application.MessageBox('即进处理接收信息，可能需要等待几分钟！','提示信息',0);
  fst:=ExtractFilePath(Application.ExeName);
  label3.Caption := g_uInfo.fuserName;
  DateTimePicker1.Date:=date();
  adotable3.Open;
  vstr:=trim(adotable3['cbmh']);
  vlen:=length(vstr);
  addfile;
end;

procedure Tdfmreceive.addtemp(atbltemp:Tadotable);
var
  i,j,t:Integer;
  MyLine:String;
//  vtype:Tfieldtype;
begin
  with atbltemp do
  begin
    Open;
    for i:= 0 to RichEdit1.Lines.Count-1 do
    begin
//      MyLine:=RegulateStr(Richedit1.Lines[i], Space); //去掉多余的分割符,规范字符串
      MyLine:=RegulateStr(Richedit1.Lines[i], Space);
//      myline:=trim(Richedit1.Lines[i]);
      if myline<>'' then
      begin
        t:=GetSubStrNum(MyLIne,Space);
//      for j:=1 to GetSubStrNum(MyLIne,Space) do   //计算一个字符串要被分割成几个字段
        append;
        for j:=1 to t+1 do
        begin
          fields[j-1].asString:=GetSubStr(MyLine, Space);
        end;
        post;
      end;  
    end;
  end;
end;

procedure Tdfmreceive.addfile;
var
//  FileToFind,cna: string;
  sr: TSearchRec;
  FileAttrs: Integer;
begin
  FileAttrs := faArchive;
  {接收分类信息}
  begin
    if FindFirst(fst+'datain\*.*', FileAttrs, sr) = 0 then
    begin
      repeat
        if (sr.Attr and FileAttrs) = sr.Attr then
        begin
          if lowercase(copy(sr.Name,0,2))='fl' then
          begin
            Richedit1.Lines.LoadFromFile(fst+'datain\'+sr.Name);
            ADOQuery1.ExecSQL;
            addtemp(adotable1);
            ADOQuery2.ExecSQL;
            Deletefile(pchar(fst+'datain\'+sr.Name));
          end;
        end;
      until FindNext(sr) <> 0;
      FindClose(sr);
    end;
  end;
  {接收变价单}
  begin
    if FindFirst(fst+'datain\*.*', FileAttrs, sr) = 0 then
    begin
      repeat
        if (sr.Attr and FileAttrs) = sr.Attr then
        begin
          if lowercase(copy(sr.Name,6,5))='price' then
          begin
            Richedit1.Lines.LoadFromFile(fst+'datain\'+sr.Name);
            ADOQuery8.ExecSQL;
            addtemp(atblprice);
            ADOQuery9.ExecSQL;
            Deletefile(pchar(fst+'datain\'+sr.Name));
          end;
        end;
      until FindNext(sr) <> 0;
      FindClose(sr);
    end;
  end;  
  {接收商品信息}
  begin
    if FindFirst(fst+'datain\*.*', FileAttrs, sr) = 0 then
    begin
      repeat
        if (sr.Attr and FileAttrs) = sr.Attr then
        begin
          if lowercase(copy(sr.Name,0,2))='sp' then
          begin
            Richedit1.Lines.LoadFromFile(fst+'datain\'+sr.Name);
            ADOQuery3.ExecSQL;
            addtemp(adotable2);
            ADOQuery4.ExecSQL;
            Deletefile(pchar(fst+'datain\'+sr.Name));
          end;
          if copy(sr.Name,0,vlen+2)=vstr+'db' then
            memo2.Lines.Append(sr.Name);
          if copy(sr.Name,0,vlen+2)=vstr+'tz' then
            memo3.Lines.Append(sr.Name);
          if copy(sr.Name,0,2)='tz' then
            memo3.Lines.Append(sr.Name);
        end;
      until FindNext(sr) <> 0;
      FindClose(sr);
    end;
  end;
end;

function Tdfmreceive.memosel(vmemo:tmemo;Index: integer): boolean;
var
  i,start,sellength:integer;
begin
  Start:=0;
  for i:=0 to Index-1 do
    Start:=Start+Length(vmemo.Lines[i])+2;
  SelLength:=length(vmemo.Lines[index]);
  vmemo.SetFocus;
  vmemo.SelStart:=Start;
  vmemo.SelLength:=SelLength;
end;

procedure Tdfmreceive.Memo2Click(Sender: TObject);
begin
  LineNum:=SendMessage(Memo2.Handle,EM_LINEFROMCHAR,Memo2.SelStart,0);
  memosel(memo2,LineNum);
  if trim(memo2.SelText) <> '' then
  begin
    Richedit1.Lines.LoadFromFile(fst+'datain\'+trim(memo2.Lines[linenum]));
    ADOQuery5.ExecSQL;
    addtemp(adotable4);
  end;  
end;

procedure Tdfmreceive.sumno;
var
  n:integer;
begin
//  if ATblstointemp.IsEmpty then
  begin
    Atblstoin.Close;
    Atblstoin.indexfieldnames:='cstinno';
    Atblstoin.Open;
    Atblstoin.Last;
    n:=strtoint(Atblstoin['cstinno']);
    n:=n+1;
    a:=inttostr(n);
    while length(a)<10 do
    begin
      a:='0'+a;
    end;
  end;
end;


procedure Tdfmreceive.BitBtn2Click(Sender: TObject);
var
  fstr:string;
begin
  if not atblslday.Locate ('cdate',formatdatetime('yyyy-mm-dd',datetimepicker1.Date),[loPartialKey]) then
  begin
    sumno;
    fstr:='insert into t_stoin (cstinno,cdate,csendbra,cinceptbra,clabel,spbh,sl,cdbj,clsj,cuser,cdbnote)'
         +' select ''%s'',cdate,csendbra,cincepbra,clabel,spbh,sl,cdbj,clsj,''%s'',cstdbno from t_stdbtemp';
    with ADOQuery6 do
    begin
      close;
      sql.Clear ;
      sql.Add(Format(fstr,[a,g_uInfo.fuserName]));
      Prepared;
      execsql;
    end;
    ADOQuery7.ExecSQL;
    Deletefile(pchar(fst+'datain\'+memo2.Lines[linenum]));
    application.MessageBox('接收完毕！','提示信息',0);
  end
  else
    application.messagebox('这个日期已日结封帐，不允许继续输入！',
        '提示信息', MB_OK);    
end;

procedure Tdfmreceive.Memo3Click(Sender: TObject);
begin
  LineNum:=SendMessage(Memo3.Handle,EM_LINEFROMCHAR,Memo3.SelStart,0);
  memosel(memo3,LineNum);
  if trim(memo3.SelText) <> '' then
//  if memo3.Lines[linenum]<>nil then
  begin
    Richedit2.Lines.LoadFromFile(fst+'datain\'+trim(memo3.Lines[linenum]));
  end;
end;

end.