commlist.pas

企业端数据申报系统：单位管理模块 单位查询. 业务申报模块 在线数据下载 在线数据上传 在线业务申核 申报业务查询 磁盘数据导出 磁盘数据导入 在线业务模块 在线业务

//模块名称：通用的代码
//参数说明：


unit commlist;

interface
uses
  fctreecombo,fcTreeView,Registry,SysUtils,Windows,DB,DBTables,Classes;

type
 TNetPara      =     record
   Http_Host    : string;
   Http_Port    : string;
   Http_Root    : string;
   Ftp_Host     : string;
   Ftp_Port     : string;
   Ftp_Username : string;
   Ftp_Password : string;
   Result_Bool  : boolean;
end;
type
  TVersion=record
    CompanyName :string;
    FileDescription :string;
    FileVersion :string;
    InternalName :string;
    LegalCopyright :string;
    LegalTradeMarks :string;
    OriginalFileName :string;
    ProductName :string;
    ProductVersion:string;
    Comments:string;
    FunVer:string;
end;

  function GetOrganCpseno(query:TQuery;organid:integer):integer;
  procedure Init_Comp(const AddTab_name:string;Sour:TfcTreeCombo);
  procedure Init_CompOrgan(Sour:TfcTreeCombo);
  procedure Init_Complist(const AddTab_name:string;Sour:TfcTreeCombo);
  procedure Init_Compitlist(Sour:TfcTreeCombo);overload;
  procedure Init_Compitlist(Sour:TfcTreeCombo;flag:string);overload;
  procedure Init_CompReaslist(Sour:TfcTreeCombo);overload;
  procedure Init_CompReaslist(where:string;Sour:TfcTreeCombo);overload;
  procedure ListNode(L,H,id:integer;item:TfcTreeNode;Sour:TfcTreeCombo);
  procedure ListDept(L,H,id:integer;item:TfcTreeNode;Sour:TfcTreeCombo);
  procedure Linkdata(dirstr,dataname:string);
  procedure LinkImpdata(dirstr,dataname:string);
  procedure LinkExpdata(dirstr,dataname:string);
  procedure DelLinkdata(dirstr,dataname:string);
  function  gf_password(as_cpcode:string):string;
  function UptypeCanDo(status:string;uptype:string):boolean;
  function GetStrValue(ReturnStr: string): TNetPara;
  function GetVerInfo(AppName:string):TVersion;
  function Fillchar(str:widestring;count:integer):widestring;
  function returnrewage(l_psseno ,l_yearno :integer;Db:Tdatabase):double;
  function returnmonth(l_psseno ,l_yearno :integer;Db:TDatabase):integer;
  //procedure WriteRecorde(filename,split:string;Query:TQuery);
  //procedure Imp_sbda_psagacct(filename,split:string;Query,DelQuery:TQuery);

type
  Tcode=record
  parentid:integer;   //父节点编码
  id:integer;         //ID编码
  e_expr:string;     //编码
  c_brif:string;   //字符
end;
type
  Torgan=record
  id:integer;           //机构编码
  parentid:integer;    //父节点编码
  name:string;        //机构名称
  disptype:string;   //机构类型
  cpseno:integer;    //单位编码
end;

var
  code:array of Tcode;
  organ:array of Torgan;

implementation

uses datashare, main;

function GetVerInfo(AppName:string):TVersion;
var
  S: string;
  n, Len, i: DWORD;
  Buf: PChar;
  Value: PChar;
begin
  S := Appname;
  n := GetFileVersionInfoSize(PChar(S), n);
  if n > 0 then
  begin
    Buf := AllocMem(n);
    GetFileVersionInfo(PChar(S), 0, n, Buf);
    
    VerQueryValue(Buf, PChar('StringFileInfo\040904E4\CompanyName'), Pointer(Value), Len);
    result.CompanyName:=value;
    VerQueryValue(Buf, PChar('StringFileInfo\040904E4\FileDescription'), Pointer(Value), Len);
    result.FileDescription:=value;
    VerQueryValue(Buf, PChar('StringFileInfo\040904E4\FileVersion'), Pointer(Value), Len);
    result.FileVersion:=value;
    VerQueryValue(Buf, PChar('StringFileInfo\040904E4\InternalName'), Pointer(Value), Len);
    result.InternalName:=value;
    VerQueryValue(Buf, PChar('StringFileInfo\040904E4\LegalCopyright'), Pointer(Value), Len);
    result.LegalCopyright:=value;
    VerQueryValue(Buf, PChar('StringFileInfo\040904E4\LegalTradeMarks'), Pointer(Value), Len);
    result.LegalTradeMarks:=value;
    VerQueryValue(Buf, PChar('StringFileInfo\040904E4\OriginalFileName'), Pointer(Value), Len);
    result.OriginalFileName:=value;
    VerQueryValue(Buf, PChar('StringFileInfo\040904E4\ProductName'), Pointer(Value), Len);
    result.ProductName:=value;
    VerQueryValue(Buf, PChar('StringFileInfo\040904E4\ProductVersion'), Pointer(Value), Len);
    result.ProductVersion:=value;
    VerQueryValue(Buf, PChar('StringFileInfo\040904E4\Comments'), Pointer(Value), Len);
    result.Comments:=value;

    if (pos('std',result.Comments)>0) or (pos('标准版',result.Comments)>0) then
    begin
      result.FunVer:='std';
    end else
    if (pos('pro',result.Comments)>0) or (pos('专业版',result.Comments)>0) then
    begin
      result.FunVer:='pro';
    end else
    if (pos('eps',result.Comments)>0) or (pos('企业版',result.Comments)>0) then
    begin
      result.FunVer:='eps';
    end;

    FreeMem(Buf, n);
  end;

end;

function GetStrValue(ReturnStr: string): TNetPara;
var
   iStart,iPos : integer;
   currStr     : String;
   sList       : TstringList;
begin
   currStr := ReturnStr;
   if pos('|',Currstr) = 0 then
   begin
        Result.Result_Bool      := False;
        Exit;
   end;
   try
      sList := TStringList.Create;
      iStart := 0;
      while pos('|',Currstr)>0 do
      begin
        iPos    := pos('|',Currstr);
        sList.Add(copy(Currstr,iStart,iPos-1));
         CurrStr := Copy(CurrStr,iPos+1,Length(Currstr));
      end;
      sList.Add(CurrStr);
      if sList.Count <> 7 then
      begin
           Result.Result_Bool      := False;
           exit;
      end;
      with  result do
      begin
           Http_Host        := sList[0];
           Http_Port        := sList[1];
           Http_Root        := sList[2];
           Ftp_Host         := sList[3];
           Ftp_Port         := sList[4];
           Ftp_Username     := sList[5];
           Ftp_Password     := sList[6];
           Result_Bool      := True;
      end;
   finally
   sList.Free;
   end;
end;

function UptypeCanDo(status:string;uptype:string):boolean;
begin
  if (status='0') and ((uptype='01') or (uptype='03')) then
    result:=true
  else if (status='1') and ((uptype='04') or (uptype='05') or (uptype='06') or (uptype='07')) then
    result:=true
  else if (status='2') and ((uptype='02') or (uptype='06') or (uptype='07')) then
    result:=true
  else
    result:=false;

  exit;
end;

function GetOrganCpseno(query:TQuery;organid:integer):integer;
var
  ls_sql:string;
  li_cpseno,li_parentid,reccount,i:integer;
begin
  try
    query.Close;
    query.SQL.Clear;
    query.SQL.Add('select count(*) reccount from organization');
    query.Prepare;
    query.Open;
    reccount:=query.fieldbyname('reccount').AsInteger;
    query.Close;
  
    li_cpseno:=-1;
    for i:=1 to reccount do
    begin
      query.Close;
      query.SQL.Clear;
      ls_sql:='select parentid,cpseno from organization where id='+inttostr(organid);
      query.SQL.Add(ls_sql);
      query.Prepare;
      query.Open;
      if query.RecordCount<1 then
        break;
      li_parentid:=query.FieldByName('parentid').AsInteger;
      if li_parentid=0 then
      begin
        li_cpseno:=query.fieldbyname('cpseno').AsInteger;
        break;
      end;
      organid:=li_parentid;
    end;
    query.Close;
    result:=li_cpseno;
  except
    on e:exception do
    begin
      result:=-1;
    end;
  end;
end;

function  gf_password(as_cpcode:string):string;
var
  ll_asc:array[0..7] of LongWord;
  ll_A,ll_B,ll_C:LongWord;
  ls_pwd,ls_add:string;
  ll_count:word;
  //temp:char;
  temp_str:array[0..15] of char;
begin
  as_cpcode:=Trim(as_cpcode);
  for ll_count:=0 to 7 do
    ll_asc[ll_count]:=0;
  For ll_count:=1 To Length(as_cpcode) do
    ll_asc[ll_count-1]:= 0;
//  setlength(temp_str,length(as_cpcode));
  strpcopy(temp_str,as_cpcode);
  For ll_count:=1 To Length(as_cpcode) do
    ll_asc[ll_count-1]:=ord(temp_str[ll_count-1]);
  ll_A:= 4246576443*(ll_asc[0]+8)*11 + (67+ll_asc[1])*5 + (89+ll_asc[2])*3 + (56+ll_asc[3])*17 + (23+ll_asc[4]) + ll_asc[5]*19 - ll_asc[6] + ll_asc[7]*29;
  ll_B:= 1078768653 * (ll_asc[0]+5)*30 + ll_asc[1]*3 - ll_asc[2]*7 + ll_asc[3]*17 - ll_asc[4] + ll_asc[5]*19 - ll_asc[6] + ll_asc[7]*6;
  ll_C:= 1859853747 * (ll_asc[0]+7)*13 + ll_asc[1]*7 - ll_asc[2]*3 + ll_asc[3]*19 - ll_asc[4] + ll_asc[5]*37 - ll_asc[6] + ll_asc[7]*61;
  //showmessage(inttostr(ll_A));
  //showmessage(inttostr(ll_B));
  //showmessage(inttostr(ll_C));
  ls_add:= inttostr(ll_A) + inttostr(ll_B) + inttostr(ll_C);
 // showmessage(ls_add);
  For ll_count:=1 To Length(ls_add) do
  begin
    if odd(ll_count) then
      ls_pwd:=ls_pwd+chr(strtoint(copy(ls_add,ll_count,2)));
  end;
  //showmessage(ls_pwd);
  Result:=ls_pwd;
end;

procedure Init_CompReaslist(where:string;Sour:TfcTreeCombo);
var
  Str:string;
  NewItem:TfcTreeNode;
begin
  with datashare_frm.Query1 do
  begin
    close;
    sql.Clear;
    str:='select upcode,upname from upreason where '+where;
    sql.Add(str);
    prepare;
    open;
    while not eof do
    begin
      NewItem:=Sour.Items.AddChild(nil,fieldbyname('upname').AsString);
      NewItem.StringData:=fieldbyname('upcode').AsString;
      next;
    end;
  end;
  Sour.TreeView.FullCollapse;
end;

procedure Init_CompReaslist(Sour:TfcTreeCombo);
var
  Str:string;
  NewItem:TfcTreeNode;
begin
  with datashare_frm.Query1 do
  begin
    close;
    sql.Clear;
    str:='select upcode,upname from upreason where uptype=:p1 or uptype=:p2';
    sql.Add(str);
    params[0].AsString:='01';
    params[1].AsString:='03';
    prepare;
    open;
    while not eof do
    begin
      NewItem:=Sour.Items.AddChild(nil,fieldbyname('upname').AsString);
      NewItem.StringData:=fieldbyname('upcode').AsString;
      next;
    end;
  end;
  Sour.TreeView.FullCollapse;
end;

procedure Init_Compitlist(Sour:TfcTreeCombo);
var
  str:string;
  NewItem:TfcTreeNode;
begin
  with datashare_frm.Query1 do
  begin
    close;
    sql.Clear;
    str:='select itcode,itname from pycode';
    sql.Add(str);
    prepare;
    open;
    while not eof do
    begin
      NewItem:=Sour.Items.AddChild(nil,fieldbyname('itcode').AsString+fieldbyname('itname').AsString);
      NewItem.StringData:=fieldbyname('itcode').AsString;
      next;
    end;
  end;
  Sour.TreeView.FullCollapse;
end;

procedure Init_Compitlist(Sour:TfcTreeCombo;flag:string);overload;
var
  str:string;
  NewItem:TfcTreeNode;
begin
  with datashare_frm.Query1 do
  begin
    close;
    sql.Clear;
    str:='select itcode,itname from pycode';
    sql.Add(str);
    prepare;
    open;
    while not eof do
    begin
      NewItem:=Sour.Items.AddChild(nil,fieldbyname('itname').AsString);
      NewItem.StringData:=fieldbyname('itcode').AsString;
      next;
    end;
  end;
  Sour.TreeView.FullCollapse;
end;

procedure Init_Complist(const AddTab_name:string;Sour:TfcTreeCombo);
var
  str:string;
  NewItem:TfcTreeNode;
begin
  with datashare_frm.Query1 do
  begin
    close;
    sql.Clear;
    str:='select code,name from sbcode where type=:para1';
    sql.Add(str);
    params[0].Value:=AddTab_name;
    prepare;
    open;
    while not eof do
    begin
      NewItem:=Sour.Items.AddChild(nil,fieldbyname('name').AsString);
      NewItem.StringData:=fieldbyname('code').AsString;
      next;
    end;
  end;
  Sour.TreeView.FullCollapse;
end;

procedure Init_Comp(const AddTab_name:string;Sour:TfcTreeCombo);
var
  NewItem:TfcTreeNode;
  Str:string;
  i,k:integer;
begin
  with datashare_frm.Query1 do
  begin
    close;
    sql.Clear;
    Str:='select parentid,id,e_expr,c_brif from codetab where CHOOSE=:para1 and C_Expr=:para2';
    sql.Add(Str);