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

📄 dataimport.pas

📁 企业端数据申报系统:单位管理模块 单位查询. 业务申报模块 在线数据下载 在线数据上传 在线业务申核 申报业务查询 磁盘数据导出 磁盘数据导入 在线业务模块 在线业务
💻 PAS
📖 第 1 页 / 共 2 页
字号:

unit dataimport;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, basepop, StdCtrls, TFlatButtonUnit, TFlatEditUnit,
  TFlatListBoxUnit, TFlatMemoUnit, DB, DBTables,Registry, Grids, DBGrids,
  Buttons,Math,StrUtils, ActnList, ComCtrls, jpeg, ExtCtrls, ztvregister,
  ztvBase, ztvUnZip;

const
  cLicenseString = '17055475153342401579512r612895AS';

type
  TDataImport_frm = class(Tbasepop_frm)
    FlatEdit1: TFlatEdit;
    FlatButton1: TFlatButton;
    Label1: TLabel;
    FB_next: TFlatButton;
    FB_cancel: TFlatButton;
    Label2: TLabel;
    FlatEdit2: TFlatEdit;
    OpenDialog1: TOpenDialog;
    Memo2: TMemo;
    Query1: TQuery;
    Table1: TTable;
    Database1: TDatabase;
    BatchMove1: TBatchMove;
    Table2: TTable;
    Memo1: TMemo;
    Query2: TQuery;
    ActionList1: TActionList;
    help: TAction;
    Panel1: TPanel;
    Image1: TImage;
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    Memo3: TMemo;
    TabSheet2: TTabSheet;
    Label4: TLabel;
    GroupBox3: TGroupBox;
    FB_previous: TFlatButton;
    FB_help: TFlatButton;
    UnZip: TUnZip;
    procedure FlatButton1Click(Sender: TObject);
    procedure FB_nextClick(Sender: TObject);
    procedure FB_previousClick(Sender: TObject);
    procedure FB_cancelClick(Sender: TObject);

 //   function  gf_password(as_cpcode:string):string;
  private
    //procedure DeleteAll;
    function GetFieldName(Query:TQuery;SQLstr:widestring):widestring;
    { Private declarations }
  public
    { Public declarations }

  end;

  {function  XceedZipInitDLL : LongInt; stdcall; external 'XceedZip.DLL';
  function  XceedZipShutdownDLL : LongInt; stdcall; external 'XceedZip.DLL';

  function  XzCreateXceedZipA( pszLicense : PChar) : LongInt; stdcall; external 'XceedZip.DLL';
  procedure XzSetZipFilenameA( hZip : LongInt; pszValue : PChar); stdcall; external 'XceedZip.DLL';
  procedure XzSetProcessSubfolders( hZip : LongInt; bValue : LongInt ); stdcall; external 'XceedZip.DLL';

  procedure XzSetEncryptionPasswordA(hZip:LongInt;pwd:PChar); stdcall; external 'XceedZip.DLL';
  procedure XzSetUnzipToFolderA( hZip : LongInt; pszValue : PChar); stdcall; external 'XceedZip.DLL';
  procedure XzDestroyXceedZip( hZip : LongInt ); stdcall; external 'XceedZip.DLL';

  function  XzUnzip( hZip : LongInt ) : LongInt; stdcall; external 'XceedZip.DLL'; }

var
  DataImport_frm: TDataImport_frm;

implementation

uses imp, datashare, Main;



{$R *.dfm}
function  TDataImport_frm.GetFieldName(Query:TQuery;SQLstr:widestring):widestring;
var
  i:integer;
  str:widestring;
begin
   with Query do
     begin
       close;
       sql.Clear ;
       sql.Add(sqlstr);
       open;
       str:='';
       for i:=0 to FieldCount-1 do
          if str='' then str:=Fields[i].FieldName else str:=str+','+Fields[i].FieldName ;
       close;
     end;
     Result:=str;
end;

procedure Imp_sbdz(filename,tablename,split:string;fieldnames:widestring;Query,DelQuery:TQuery); overload;
var                                        //以人员内码为条件删除记录会出现问题,必须加上opdate,opcode
  line,fieldstr,valuestr,str1:widestring;
  txt:Tstrings;
  i,j,pos1,pos2:integer;
  str:string;
  fieldname:array[0..99] of string;
  b1:boolean;
begin
  if not  FileExists(filename) then  exit;
  with delQuery do
    begin
      close;
      sql.Clear ;
      sql.Add('delete from  '+tablename+'  where  psseno=:param1');
    end;
    //b1:=false;
    str1:=fieldnames+',';
    i:=pos(',',str1);pos2:=0;
    while i>1 do
      begin
        fieldname[pos2]:=trim(copy(str1,1,i-1));
        inc(pos2);
        str1:=copy(str1,i+1,length(str1)-i);
        i:=pos(',',str1);
      end;

    txt:=Tstringlist.Create ;
    txt.LoadFromFile(filename);
  for i:=0 to txt.Count-1 do
    begin
      line:=txt[i];
      pos1:=0;
      j:=pos(split,line); fieldstr:='';valuestr:='';  b1:=false;   // b2:=false;
      while (j>0) and (pos1<=pos2) do
        begin
            if j>1 then
            str:=copy(line,1,j-1)
            else
              begin
                line:=copy(line,j+1,length(line)-j);
                j:=pos(split,line);
                inc(pos1);
                continue ;
              end;
            //str:=copy(line,1,j-1);
            str:=trim(str);
            line:=copy(line,j+1,length(line)-j);
            {if (pos1=0)  then
              DelQuery.Params[pos1].AsString :=trim(str);}
            if str<>'' then
              begin
                if fieldstr='' then
                  begin
                    fieldstr:='('+Fieldname[pos1];
                    valuestr:='('+Quotedstr(str);
                    if fieldname[pos1]='psseno' then
                      begin
                        DelQuery.ParamByName('param1').AsString :=str;
                        b1:=true;
                      end;
                  end
                else
                  begin
                    fieldstr:=fieldstr+','+fieldname[pos1];
                    valuestr:=valuestr+','+Quotedstr(str);
                    if fieldname[pos1]='psseno' then
                      begin
                        DelQuery.ParamByName('param1').AsString :=str;
                        b1:=true;
                      end;
                  end;
              end;
            inc(pos1);
            j:=pos(split,line);
          end;
        if (b1) then
          begin
            DelQuery.Prepare ;
            DelQuery.ExecSQL ;
          end;
        with Query do
          begin
            close;
            sql.Clear ;
            sql.Add('insert into '+tablename);
            sql.Add(Fieldstr+')');
            sql.Add('values');
            sql.Add(valuestr+')');
            Prepare ;
            ExecSQL ;
          end;
    end;
 txt.Free ;
 deletefile(pchar(filename));
end;

{procedure TDataImport_frm.DeleteAll;
var
 directory:Widestring;
begin
  directory:=extractfilepath(application.ExeName)+'importfile\';
  if fileexists(directory+'sbdb_cparch.txt') then
     deletefile(directory+'sbdb_cparch.txt');
  if fileexists(directory+'sbdb_psarch.txt') then
    deletefile(directory+'sbdb_psarch.txt');
  if fileexists(directory+'sbdb_rtarch.txt') then
    deletefile(directory+'sbdb_rtarch.txt');
  if fileexists(directory+'sbda_psagacct.txt') then
     deletefile(directory+'sbda_psagacct.txt');
  if fileexists(directory+'sbdu_pswgcase.txt') then
    deletefile(directory+'sbdu_pswgcase.txt');
  if fileexists(directory+'sbda_psrtacct.txt') then
    deletefile(directory+'sbda_psrtacct.txt');

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -