unit U_COMMFUNC;

interface

uses
     Windows,SysUtils,Classes,alarmlist,registry,inifiles,Dialogs,Controls
     , CheckLst,StdCtrls,forms, shellapi;
type
  EDLLLoadError = class(Exception); //定义异常类，捕捉调用DLL异常

  //xxy 2021-12-28 所有后台数据库调用函数,都增加数据库类型参数,以便将来扩充功能 ;dbtype:Integer=0:
  TGetStringsList = function(user,pass,serv,sqlstr:pchar;var l:TStrings;dir:pchar;dbtype:Integer=0):boolean;stdcall; 
  TRunBack = function(CMDLine,param:pchar;isShow:boolean=false):boolean;stdcall;

  TStartMulSelect = function(user,pass,serv,sqlstr:pchar;var inSelectValues,SelectItem:TStrings;dir:pchar; isOnlyOne:Boolean=false;dbtype:Integer=0):boolean;stdcall; 
  TTestConnect = function(user,pass,serv,dir:pchar;dbtype:Integer=0):boolean;stdcall;

  TGetStringsListEx = function(user,pass,serv,sqlstr:pchar;var l:pchar;dir:pchar;dbtype:Integer=0):boolean;stdcall; 
  TStartMulSelectEx = function(user,pass,serv,sqlstr:pchar;var inSelectValues,SelectItem:pchar;dir:pchar; isOnlyOne:Boolean=false;dbtype:Integer=0):boolean;stdcall; 
  TSetOracleEnv = function(dir:pchar;IsOCI:Boolean=true;dbtype:Integer=0):boolean;stdcall;
  TArray = array of string;
  TTestFTP = procedure(ftp_host, ftp_user, ftp_pass: pchar; ftp_port: Integer;passive:boolean=false);stdcall;

  procedure StartSelect(sqlstr:String;var selectValues,SelectItem:TStrings;u,p,s,dir:String;dbtype:Integer=0);
  function TestConntion(u,p,s,dir:String;dbtype:Integer=0):boolean;
  function GetStringsList2(sqlstr: String;var dest:TStrings;u:String;p,s,dir:String;dbtype:Integer=0):boolean;
    procedure RunBack(param: String;cmd:String='';isSow:Boolean=false);
    function getParam:String;
    procedure setDatabaseParam(u,p:String;dbtype:Integer=0);
    function GetCurrentScheme(name:String):Boolean;
    function GetParFileName(name:String;imp:String=''):String;
    function GetADOConnectString(user,pass,serv:String):String;
    procedure SaveLastTime(index,GroupNum,GroupIndex:Integer); 
    procedure SaveLogFile(logIndex:Integer;msg:String='');
    function SetAutoRun(isQuery,isAutoRun:Boolean):boolean;
    function SetAlarmLists(value:Array of String;GroupNum,GroupIndex:Integer):Integer;
    procedure GetInitParam;
    function DelSelectScheme(index:Integer):Boolean;
    procedure SetDefaultScheme(name:String);
    procedure SetMainValue(name,value:String);
    function GetMainValue(name,default:String):String;

    procedure SETSELECT(SENDER:TObject);//CheckListBox:TCheckListBox;I:INTEGER);
    function GetSelectText(CheckListBox:TCheckListBox;isString:Boolean=true):String;

    function covertStringsList(sour,dest:TStringList):boolean;
    procedure GetStringsList1(var dest:TStrings;sqlstr:String;u,p,s,dir:String;dbtype:Integer=0);
    function CallRunBack(CMDLine,param:String;isSow:Boolean=false):boolean;

    procedure ShowOtherParam(form:Tform;value:TStrings;isExp:boolean=true);
    procedure GetOtherParam(var dest:TStrings;form:Tform;isExp:boolean=true);

    procedure SetExpParamDefault(chkbox:TCheckListBox;param1:array of string;param2:array of string);
    function ShowExpTables(value:TStrings;memo:TMemo):String;
    procedure ShowExpOwners(value:TStrings;memo:TMemo;chkbox:TCheckListBox);
    function CheckTablesOwner(memo:TMemo):String;

    procedure WriteIniParam(index,count:Integer;isIMP:integer;name,value:Array of String);
    procedure GetExpParam(var dest:TStrings;cl:TCheckListBox;name,value:Array of String);

    function getServerdate(u,p,s,dir:String):String;
    function nvl(s:String;def:String=' '):String;
    //2012-09-15 取ORACLE的HOME目录
    function GetOracleHomeDir:String;
    //2012-09-16 取消目录的最后一个\字符
    function CheckLastDir(dir:String):String;
    //2012-09-16 设置ORACLE环境 2015-06-26 增加是否使用 OCI
    procedure SetOracleEnv(Ora_dir:String;IsOCI:boolean=true;dbtype:Integer=0);
    //xxy 2019-11-05 增加保存错误日志的函数
    procedure SaveErrorLog(msg:String);
    //xxy 2019-11-08 设置下拉框列表
    procedure SetTheItems(items:TStrings;value:Array of String);
    //xxy 2020-09-05 增加 split
    function split(sour,sub:String):TArray;
    //xxy 2020-09-09 增加测试ftp服务器
    function TestFTP(ftp_host, ftp_user, ftp_pass: String; ftp_port: Integer;passive:boolean=false):String;



const
    AutoRunKey:String='ORACLE BACKUP';
    RunLogFile:Array[0..6] of String=('expback_run.log','expback_exp.log','expback_set.log','impback_set.log','impback_imp.log','impback_run.log','planback.log');
    //0:自动运行日志;1:临时导出日志;2:方案设置日志;3:导入设置日志;4:导入运行日志;5:导入自动运行日志 
    ADOConnectStr:String='Provider=MSDAORA.1;Persist Security Info=True;';
    YESWORD:String='Y';
    NOWORD:String='N';
    ORACLE_KEY:String='SOFTWARE\ORACLE';
    WINRAR_KEY:String='Applications\WinRAR.exe\shell\open\command';
    PAR_DEFAULT_FILE:String='缺省';
    LOG_DIR:String='log';
    PAR_DIR:String='par';
    BatchName:String='expback.bat';
    ImportName:String='impdata.bat';
    EXP_PARAM:Array[0..2,0..7] Of String=
    (('压缩区','导出权限','导出索引','导出数据行','导出限制','直接路径','导出触发器','交叉表一致性'),
    ('COMPRESS','GRANTS','INDEXES','ROWS','CONSTRAINTS','DIRECT','TRIGGERS','CONSISTENT'),
    ('Y','Y','Y','Y','Y','N','Y','Y'));
    ExportParamCount = 32; 
    SCHEME_VALUES:Array[0..ExportParamCount] Of String= 
      ('NAME','PARFILE','RUNTIME','RUNDATE','CYCLE','USERNAME','PASSWORD','SERVER','ARCDIR','ISZIP'
      ,'SAVECYCLE','LEVELAST','FTP_HOST','FTP_USE','FTP_PASS','FTP_PORT','FTP_DMP','FTP_RAR','LASTTIME','RUNCOUNT'
      ,'THEHOLDDAYS','ISDELZIP','FTP_DIR','ZIPPASSWORD','ORACLEHOME','SERVER2','NoPassive','IsShow','IsContinue','DbType','INCTYPE'
      ,'FtpIsUtf8','FtpIsUTC'
    );
    {  //xxy 2019-12-28 移植到 Alarm.pas 中,方便统一增加周期类型
    RUN_CYCLE:Array[0..9] of String=  //2012-02-28增加每天定时周期
      ('不自动运行','每天','每月','每年','定时运行一次','启动运行一次','周期','启动延时运行','每周','每天定时周期'
    );  }
    SAVE_CYCLE:Array[0..7] of String=
      ('全部','一个月','一周','本月','本周','当天','指定','不保存'   
    );
    RIGHT_OR_NO:Array[0..1] of String=
      ('否','是'
    );
    DLLFILENAME='servdata.dll';
    EXP_IMP_OTHER_PARAM:array[0..3,0..2] of String=
     (('BUFFER','FILESIZE','QUERY'),
      ('se_buffer','se_filesize','Ed_query'),
      ('BUFFER','FILESIZE','COMMIT'),
      ('se_buffer','se_filesize','se_commit')
     );

    IMP_PARAM:Array[0..2,0..9] Of String=
    (('只列出文件内容','忽略创建错误','导入权限','导入索引','导入数据行','导入限制','覆盖表空间数据文件','跳过不可用索引','执行ANALYZE','重新计算统计值'),
    ('SHOW','IGNORE','GRANTS','INDEXES','ROWS','CONSTRAINTS','DESTROY','SKIP_UNUSABLE_INDEXES','ANALYZE','RECALCULATE_STATISTICS'),
    ('N','N','Y','Y','Y','Y','N','N','Y','N'));

     ImportParamCount = 22; 
     IMPSCHEME_VALUES:Array[0..ImportParamCount] Of String= 
      ('NAME','PARFILE','RUNTIME','RUNDATE','CYCLE','USERNAME','PASSWORD','SERVER','ARCDIR','ISDELCURRENT'
      ,'ISCREATEUSER','USERROLE','USERGRANT','INDEXFILENAME','ISINDEXFILE','FILE','USERNAME2','PASSWORD2','LASTTIME','RUNCOUNT'
      ,'ORACLEHOME','SERVER2','INCTYPE'
    );
    IMP_SECTION_NAME:String='IMPSCHEME';
    DEFAULT_DMP_FILENAME:String='EXPDAT.DMP';
    //xxy 2019-11-07 计划参数名称数组
    PlanParamCount = 10; 
    PLAN_VALUES:Array[0..PlanParamCount] Of String=
      ('NAME','RUNTIME','RUNDATE','CYCLE','LASTTIME','RUNCOUNT','ISSTART','SECTIONS','SECTIONNAMES','INDEX','IsShow'
    );
    //xxy 2019-11-12 计划列表组序号列号
    PlanGroupIndexCol=8;
    //xxy 2020-09-05 增量备份类型
    INCTYPE_PARAM:Array[0..5] Of String=
    ('Complete,Incremental,Cumulative','完全,增量型,累计型'  //ORACLE
      ,'INIT,Differential','全库,增量' //SQL Server
      ,'INIT','全库' //MySQL
    );
    //xxy 2020-09-07 增量备份数据库类型
    Database_Types:Array[0..2] Of String= ('Oracle','SQLServer','MySQL');


var
    OracleDir,ServerDate,winrarPath:String; 
    iniFileName:String;
    AlarmLists1:TAlarmLists;
    Current_Scheme_Values:Array[0..ExportParamCount] Of String;
    Scheme_Count:Integer;
    IMPScheme_Count:Integer;
    IMPCurrent_Scheme_Values:Array[0..ImportParamCount] Of String;
    WorkDir:String;
    //xxy 2019-11-07 备份计划数
    Plan_Count:Integer;
    Current_Plan_Values:Array[0..PlanParamCount] Of String;


implementation
uses u_main,u_des;

procedure SETSELECT(SENDER:TObject);
VAR 
  I:INTEGER;
begin
  I:=(SENDER AS TCheckListBox).ItemIndex;
  (SENDER AS TCheckListBox).Checked[I]:=NOT ((SENDER AS TCheckListBox).Checked[I]);
end;

function GetSelectText(CheckListBox:TCheckListBox;isString:Boolean):String;
var 
  I:Integer;
  s:String;
begin
   Result:='';
   for i := 0 to CheckListBox.Items.Count-1 do
   begin
       If CheckListBox.Checked[i] Then
       Begin
           s:=CheckListBox.Items.Strings[i];
           If isString Then
               s:=''''+s+'''';
           If Result<>'' Then
               Result:=Result+',';
           Result :=Result+s;
       End;
   end;
end;

function covertStringsList(sour,dest:TStringList):boolean;
var 
  i:integer;
  s:String;
begin
  result:=true;
  if sour.Count>0 then
  begin
    for i := 0 to sour.Count-1 do
    begin
        s:=sour.Strings[i];
        dest.Append(s);
    end;
end;
end;

procedure GetStringsList1(var dest:TStrings;sqlstr:String;u,p,s,dir:String;dbtype:Integer=0);
begin
  dest.Clear;
  GetStringsList2(sqlstr,dest,u,p,s,dir,dbtype);
end;

function GetStringsList2(sqlstr:String;var dest:TStrings;u:String;p,s,dir:String;dbtype:Integer=0):boolean;//TStringList;
var
  LibHandle: THandle;
  P_device:TGetStringsListEx;
  s1:pchar;
begin
  Result:=true;
  LibHandle := LoadLibrary(pchar(dllfilename));
  s1 := '';
  try
    if LibHandle <=32 then raise EDLLLoadError.Create('调用 '+dllfilename+' 失败！')
    else
    begin
      @P_device := GetProcAddress(LibHandle, 'GetStringsListEx');
      if not (@P_device = nil) then
      begin
        try
         if (u='') then
         begin
             u:=Current_Scheme_Values[5];
             p:=decode_string(Current_Scheme_Values[6]);
             s:=Current_Scheme_Values[7];
         end;
         if (s='') then
           s:=Current_Scheme_Values[7];

         P_device(pchar(u),pchar(p),pchar(s),pchar(sqlstr),s1,pchar(dir),dbtype);
         dest.Text := String(s1);
        except on e:Exception do
        end;
      end;
    end;

  finally
    FreeLibrary(LibHandle);
  end;
end;

procedure RunBack(param:String;cmd:String='';isSow:Boolean=false);
begin
  if (cmd='') Then
    cmd:=BatchName;

  if cmd <> BatchName then
    CallRunBack(cmd,param,isSow)
  else begin
    if isSow then
      ShellExecute(frm_main.Handle, 'open','deloldfile.exe',pchar(cmd + ' "'+param+'" 1'), nil, SW_NORMAL)
    else
      ShellExecute(frm_main.Handle, 'open','deloldfile.exe',pchar(cmd + ' "'+param+'" 0'), nil, SW_HIDE);
  end;
end;

function CallRunBack(CMDLine,param:String;isSow:Boolean=false):boolean;
var
  LibHandle: THandle;
  P_device2:TRunBack;
begin
  Result:=false;
  LibHandle := LoadLibrary(dllfilename);
  try
    if LibHandle <=32 then raise EDLLLoadError.Create('调用 '+dllfilename+' 失败！')
    else
    begin
      @P_device2 := GetProcAddress(LibHandle, 'RunBack');
      if not (@P_device2 = nil) then
      begin
         try
            Result:=P_device2(pchar(CMDLine),pchar(param),isSow);
         except
         end;
      end;
    end;
  finally
    FreeLibrary(LibHandle);
  end;
end;


function getParam:String;
var param:String;
begin
    setDatabaseParam(Current_Scheme_Values[24],Current_Scheme_Values[25]);

    param:='';
    ServerDate:=getServerDate('','','','');

    if Current_Scheme_Values[9]='1' then
        param := param+winrarPath
    else
        param := param+'NULL';
    param := param+' ';
    If Current_Scheme_Values[1]<>PAR_DEFAULT_FILE Then 
      param := param+Current_Scheme_Values[1]
    else
      param := param+'NULL';
    param := param+' '+ServerDate;
    Result:=param;
end;

function getServerdate(u,p,s,dir:String):String;
var 
  t:TStrings;
begin
  t := TStringlist.Create;
  try
    result := '';
    if result='' then
        result:=FormatDateTime('YYYY-MM-DD',DATE);
  finally
    t.Destroy;
  end;
end;

procedure setDatabaseParam(u,p:String;dbtype:Integer=0);
begin
  SetOracleEnv(u,(dbtype > 0) or (pos(':',p)>0),dbtype);
end;

function GetCurrentScheme(name:String):Boolean;//=true
var ini: TIniFile;
d:String;
i:Integer;
begin
    ini:=TIniFile.Create(iniFileName);
    if not ini.SectionExists(name) then
    begin
      ini.Destroy;
      result := false;
      exit;
    end;
    result := true;

    for i := 0 to length(SCHEME_VALUES)-1  do
    begin
        Current_Scheme_Values[i]:=ini.ReadString(name,SCHEME_VALUES[i],'');
    end;
    ini.Destroy;
    If Current_Scheme_Values[3]='' Then
        Current_Scheme_Values[3]:=FormatDateTime('YYYY-MM-DD',date);
    If Current_Scheme_Values[4]='' Then
        Current_Scheme_Values[4]:='0';
    If Current_Scheme_Values[2]='' Then
        Current_Scheme_Values[2]:='00:00:00';
    If Current_Scheme_Values[9]='' Then
        Current_Scheme_Values[9]:='1';
    If Current_Scheme_Values[10]='' Then
        Current_Scheme_Values[10]:='0';
    If Current_Scheme_Values[11]='' Then
        Current_Scheme_Values[11]:='1';

    If Current_Scheme_Values[16]='' Then
        Current_Scheme_Values[16]:='1';
    If Current_Scheme_Values[17]='' Then
        Current_Scheme_Values[17]:='1';

    If Current_Scheme_Values[19]='' Then //运行次数
        Current_Scheme_Values[19]:='0';
    If Current_Scheme_Values[22]='' Then 
        Current_Scheme_Values[22]:='databack';
    //2012-09-15 增加ORACLE_HOME的缺省值
    If Current_Scheme_Values[24]='' Then
    begin
      //xxy 2019-11-07 缺省用本地的 Oracle10gClient 客户端
      if DirectoryExists(WorkDir+'\..\Oracle10gClient') then
      begin
        d := GetCurrentDir;
        SetCurrentDir(WorkDir+'\..\Oracle10gClient');
        Current_Scheme_Values[24] := GetCurrentDir;
        SetCurrentDir(d);
      end else begin
        Current_Scheme_Values[24] := OracleDir;
      end;
    end;
    //xxy 2016-05-16 增加直接连接地址的缺省值
    If Current_Scheme_Values[25]='' Then
        Current_Scheme_Values[25] := Current_Scheme_Values[7];
    If (Current_Scheme_Values[29]='-1') or (Current_Scheme_Values[29]='') Then
        Current_Scheme_Values[29]:='0';
    If (Current_Scheme_Values[30]='-1') or (Current_Scheme_Values[30]='') Then
        Current_Scheme_Values[30]:='0';
    //xxy 2021-12-28 增加Ftp是否UTF8和时区转换
    If (Current_Scheme_Values[31]='-1') or (Current_Scheme_Values[31]='') Then
        Current_Scheme_Values[31]:='0';  
    If (Current_Scheme_Values[32]='-1') or (Current_Scheme_Values[32]='') Then
        Current_Scheme_Values[32]:='0';  
end;

function GetParFileName(name:String;imp:String=''):String;
var 
  s:String;
begin
    s:=PAR_DIR+'\';
    if name='' then
        name:=Current_Scheme_Values[1];
    if name=PAR_DEFAULT_FILE then
        name:='default';
    s:=s+imp+name+'.par';
    Result:=s;
end;
{
 }

function GetADOConnectString(user,pass,serv:String):String;
begin
  Result:='Provider=MSDAORA.1;Persist Security Info=True;'
         +'User ID='+user+';Password='+pass+';Data Source='+serv;
end;

procedure SaveLastTime(index,GroupNum,GroupIndex:Integer); 
var ini: TIniFile;
s,ltime,count:String;
begin
  ini:=TIniFile.Create(iniFileName);
  ltime:=AlarmLists1.GetTheLastTime(index);
  count:=AlarmLists1.GetTheCount(index);
  s := IntToStr(GroupIndex+1);
  if GroupNum = 1 then
  begin
    s := 'PLAN' + s;
    ini.WriteString(s,PLAN_VALUES[4],ltime);
    ini.WriteString(s,PLAN_VALUES[5],count);
    Current_Plan_Values[4]:=ltime;
    Current_Plan_Values[5]:=count;
  end else begin
    s := 'SCHEME' + s;
    ini.WriteString(s,SCHEME_VALUES[18],ltime);
    ini.WriteString(s,SCHEME_VALUES[19],count);
    Current_Scheme_Values[18]:=ltime;
    Current_Scheme_Values[19]:=count;
  end;
  ini.Destroy;

end;

procedure SaveLogFile(logIndex:Integer;msg:String='');
var
s,n:String;
ltime,count:String;
hLogFile:TextFile;
begin
  try       
    n:=RunLogFile[logIndex];
    n:=workdir+'\log\'+n;
    AssignFile(hLogFile, n);
    If FileExists(n) Then
       Append(hLogFile)
    Else
       Rewrite(hLogFile);
    if logIndex < 3 then
    begin
       ltime:=Current_Scheme_Values[18];
       count:=Current_Scheme_Values[19];
       s:='方案名称:'+Current_Scheme_Values[0]+',时间:'+DatetimetoStr(Now)+',运行次数:'+count+',上次运行时间:'+lTime;
    end else if logIndex < 6 then begin
       ltime:=IMPCurrent_Scheme_Values[18];
       count:=IMPCurrent_Scheme_Values[19];
       s:='方案名称:'+IMPCurrent_Scheme_Values[0]+',时间:'+DatetimetoStr(Now)+',运行次数:'+count+',上次运行时间:'+lTime;
    end else begin
       ltime:= Current_Plan_Values[4];
       count:=Current_Plan_Values[5];
       s:= msg + ',方案名称:'+Current_Plan_Values[0]+',时间:'+DatetimetoStr(Now)+',运行次数:'+count+',上次运行时间:'+lTime;
    end;
    Writeln(hLogFile,s);
  except
  end;
  try
    CloseFile(hLogFile);
  except
  end;
end;

function SetAutoRun(isQuery,isAutoRun:Boolean):boolean;
var 
  r:TRegistry;
begin
    Result:=false;
    R:=TRegistry.Create;
    R.RootKey:=HKEY_LOCAL_MACHINE;
    r.OpenKey('SOFTWARE\Microsoft\Windows\CurrentVersion\Run',FALSE);
    if isQuery then
        Result:=r.ValueExists(AutoRunKey)
    else begin
        if isAutoRun then
            r.WriteString(AutoRunKey,ParamStr(0))
        else
            r.DeleteValue(AutoRunKey);
    end;
    r.CloseKey;
    r.Destroy;
end;

function SetAlarmLists(value:Array of String;GroupNum,GroupIndex:Integer):Integer;
var
  aName,atime,adate,CYCLE,ltime,count:String;
begin
  aName:=value[0];
  atime:=value[2];
  adate:=value[3];
  CYCLE:=value[4];
  ltime:=value[18];
  count:=value[19];
  if count='' then count:='0';
  result := AlarmLists1.AddAlarm(aName,atime,adate,ltime,1,StrToInt(count),StrToInt(CYCLE),date,date,0,0,now,GroupNum,GroupIndex);
end;

procedure WriteIniParam(index,count:Integer;isIMP:Integer;name,value:Array of String);
var ini: TIniFile;       
s,s1:String;
i:Integer;
begin
  ini:=TIniFile.Create(iniFileName);
  s1:='';
  If isIMP = 0 Then
  Begin
      if count>0 then
          ini.WriteString('MAIN','COUNT',IntToStr(count));
      s:='SCHEME'+IntToStr(index);//index);
  End else if isIMP = 1 then Begin
      if count>0 then
          ini.WriteString('MAIN','IMPCOUNT',IntToStr(count));
      s:=IMP_SECTION_NAME+IntToStr(index);
      s1:='IMP';
  End else if isIMP = 2 then  Begin  
      if count>0 then
          ini.WriteString('PLANMAIN','COUNT',IntToStr(count));
      s:='PLAN'+IntToStr(index);
      s1:='PLAN';
  End;
  if index=0 then
      s:=s1+'TEMP';
  for i := 0 to length(name)-1  do
  begin
      if (name[i]<>'') then
          ini.WriteString(s,name[i],value[i]);
  end;
  ini.Destroy;

end;

procedure GetInitParam;
var 
  r:TRegistry;
begin
    R:=TRegistry.Create;
    OracleDir := GetOracleHomeDir;

    R.RootKey:=HKEY_CLASSES_ROOT;
    R.OpenKey(WINRAR_KEY,FALSE);
    winrarPath:=UpperCase(R.ReadString(''));
    winrarPath:=ExtractFilePath(winrarPath);
    IF winrarPath='' THEN
         winrarPath:='c:\progra~1\winrar\';
    if pos('PROGRAM FILES',winrarPath)>0 Then
        winrarPath:=StringReplace(winrarPath,'PROGRAM FILES','PROGRA~1',[rfReplaceAll]);
    If winrarPath[1]='"' Then
        winrarPath:=copy(winrarPath,2,length(winrarpath)-1);
     R.CloseKey;
    r.Destroy;
    iniFileName:=ChangeFileExt(ExpandFileName(ParamStr(0)),'.ini');

end;

function DelSelectScheme(index:Integer):Boolean;
var 
  ini: TIniFile;
  s:String;
  i:Integer;
begin
  Result:=false;
  if MessageDlg('您确实希望删除当前备份方案吗?',
       mtConfirmation, [mbYes, mbNo], 0) = mrYes then
  begin
      s:='SCHEME'+IntToStr(Index+1);
      ini:=TIniFile.Create(iniFileName);
      ini.EraseSection(s);
      ini.Destroy;
      Result:=true;
  end;
end;

procedure SetDefaultScheme(name:String);
var ini: TIniFile;
begin
  ini:=TIniFile.Create(iniFileName);
  ini.WriteString('MAIN','CURRENT',name);
  ini.Destroy;
end;

procedure SetMainValue(name,value:String);
var ini: TIniFile;
begin
  ini:=TIniFile.Create(iniFileName);
  ini.WriteString('MAIN',name,value);
  ini.Destroy;
end;

function GetMainValue(name,default:String):String;
var ini: TIniFile;
begin
  ini:=TIniFile.Create(iniFileName);
  Result:=ini.ReadString('MAIN',name,default);
  ini.Destroy;
end;

procedure ShowOtherParam(form:Tform;value:TStrings;isExp:boolean);
var
i,j,jj,k,dim:integer;
s,t:String;
begin
  try
    If value.Count<1 Then
    Begin
        exit;
    End;
    jj:=length(EXP_IMP_OTHER_PARAM[0])-1;
    if isExp then
        dim:=0
    else
        dim:=2;
    for i := 0 to value.Count-1 do
    begin
        s:=TrimRight(trim(value.Strings[i]));
        for j := 0 to jj do
        begin
            if EXP_IMP_OTHER_PARAM[dim,j]='' then
                k:=0
            else
                k:=pos(EXP_IMP_OTHER_PARAM[dim,j]+'=',s);
            if k>0 then
            begin
                k:=pos('=',s)+1;
                t:=copy(s,k,length(s)-k+1);
                if t<>'' then
                begin
                     s:=EXP_IMP_OTHER_PARAM[dim+1,j];
                    (form.FindComponent(s) as TCustomEdit).Text:=t;
                end;
            end;
        end;
    end;
  except end;
end;

procedure GetOtherParam(var dest:TStrings;form:Tform;isExp:boolean);
var
i,jj,dim:integer;
s:String;
begin
    dest.Clear;
    jj:=length(EXP_IMP_OTHER_PARAM[0])-1;
    if isExp then
        dim:=0
    else
        dim:=2;
    for i := 0 to jj do
    begin
        s:=EXP_IMP_OTHER_PARAM[dim+1,i];
        s:=TrimRight(trim((form.FindComponent(s) as TCustomEdit).Text));
        if (s<>'') and (s<>'0') then
        begin
            dest.Add(EXP_IMP_OTHER_PARAM[dim,i]+'='+s)
        end;
    end;
end;

procedure SetExpParamDefault(chkbox:TCheckListBox;param1:array of string;param2:array of string);
var
i:Integer;
begin
  chkbox.Clear;
  for i := 0 to Length(param1)-1 do
  begin
      chkbox.Items.Add(param1[i]);
      chkbox.Checked[i]:=param2[i]=YESWORD;//'Y';
  end;
end;

function ShowExpTables(value:TStrings;memo:TMemo):String;
var
i,j:integer;
s:String;
begin
    memo.clear;
    If value.Count<1 Then
    Begin
        exit;
    End;
    j:=value.IndexOf('TABLES=(');
    If j<0 Then exit;
    for i := j+1 to value.Count-1 do
    begin
        s:=value.Strings[i];
        If s=')' Then Break;
        If pos(',',s)>0 Then
           s:=copy(s,2,length(s)-1);
        memo.Lines.Add(s);
    end;
end;

procedure ShowExpOwners(value:TStrings;memo:TMemo;chkbox:TCheckListBox);
var
i,j:integer;
s:String;
begin
    j:=value.Count;
    If j<1 Then exit;
    for i := 0 to j-1 do
    begin
        s:=value.Strings[i];
        If pos('OWNER=(',s)>0 Then
        Begin
            s:=','+copy(s,8,length(s)-8)+',';
            break;
        End;
        s:='';
    end;
    s:=s+CheckTablesOwner(memo);
    j:=chkbox.Items.Count;
    If j<1 Then exit;
    for i := 1 to j-1 do
    begin
        If (s<>'') and (pos(','''+chkbox.Items.Strings[i]+''',',s)>0) Then
            chkbox.Checked[i]:=true
        else
            chkbox.Checked[i]:=false;
    end;
end;

function CheckTablesOwner(memo:TMemo):String;
var
i,j:Integer;
s,s1:String;
begin
    result:='';
    for i := 0 to memo.Lines.Count-1 do
    begin
        s:=memo.Lines.Strings[i];
        j:=pos('.',s);
        if j>0 then
        begin
            s1:=','''+copy(s,1,j-1)+''',';
            if Pos(s1,result)<1 then
                Result:=result+s1;
        end;
    end;

end;

procedure GetExpParam(var dest:TStrings;cl:TCheckListBox;name,value:Array of String);
var
i:Integer;
s:String;
begin
  dest.Clear;
  for i := 0 to Length(name)-1 do
  begin
     s:=name[i];
     If value[i]<>'' Then
     begin
         if  CL.Checked[i] Then
             s:=s+'='+YESWORD//Y'
         Else
             s:=s+'='+NOWORD;//N';
         dest.Add(s);
     End Else Begin
         if  CL.Checked[i] Then
             dest.Add(s);
     End;
  end;
end;


function TestConntion(u,p,s,dir:String;dbtype:Integer=0):boolean;
var
  LibHandle: THandle;
  P_device4:TTestConnect;
begin
  Result:=false;
  LibHandle := LoadLibrary(dllfilename);
  try
    if LibHandle <=32 then raise EDLLLoadError.Create('调用 '+dllfilename+' 失败！')
    else
    begin
      @P_device4 := GetProcAddress(LibHandle, 'TestConnect');
      if not (@P_device4 = nil) then
      begin
         try
             Result:=P_device4(pchar(u),pchar(p),pchar(s),pchar(dir),dbtype);
         except
         end;
      end;
    end;
  finally
    FreeLibrary(LibHandle);
  end;
end;

procedure StartSelect(sqlstr:String;var selectValues,SelectItem:TStrings;u,p,s,dir:String;dbtype:Integer=0);
var
  LibHandle: THandle;
  P_device:TStartMulSelectEx;
  s1,s2:Pchar;
begin
  LibHandle := LoadLibrary(dllfilename);
  s1 := '';
  s2 := '';
  try
    if LibHandle <=32 then raise EDLLLoadError.Create('调用 '+dllfilename+' 失败！')
    else
    begin
      @P_device := GetProcAddress(LibHandle, 'StartMulSelectEx');
      if not (@P_device = nil) then
      begin
        try
         s1 := pchar(selectValues.Text);
         if SelectItem <> nil then
           s2 := pchar(SelectItem.Text);
         P_device(pchar(u),pchar(p),pchar(s),pchar(sqlstr),s1,s2,pchar(dir),false,dbtype);
         selectValues.Text := String(s1);
         if SelectItem <> nil then
           SelectItem.Text := String(s2);
        except
        end;
      end;
    end;
  finally
    FreeLibrary(LibHandle);
  end;
end;

function nvl(s:String;def:String=' '):String;
begin
   result:=s;
   if (s='') or (trim(s)='') then
       result:=def;
end;

function GetOracleHomeDir:String;
var
  r:TRegistry;
  s,p:String;
  ss:TStrings;
  i,c:Integer;
begin
  //先取HOME变量
  s := GetEnvironmentVariable('ORACLE_HOME');
  //在从路径取
  if s = '' then
  begin
    p := GetEnvironmentVariable('PATH');
    ss := TStringlist.Create;
    try
      ss.Text := StringReplace(p,';',#13#10,[rfReplaceAll]);
      c := ss.Count;
      if c > 0  then
      begin
        for i := 0 to c - 1 do
        begin
          p := trim(ss.Strings[i]);
          if p <> '' then
          begin
            if p[length(p)] = '\' then
              p := copy(p,1,length(p) - 1);
            if FileExists(p+'\oci.dll') then
            begin
              if copy(LowerCase(p),length(p) - 4,4) = '\bin' then
                p := copy(p,1,length(p) - 4);
              s := p;
              break;
            end;
          end;
        end;
      end;
    finally
      ss.Free;
    end;
  end;
  //从注册表读取
  if s = '' then
  begin
    R:=TRegistry.Create;
    R.RootKey:=HKEY_LOCAL_MACHINE;
    r.OpenKey(ORACLE_KEY,FALSE);
    s := r.ReadString('ORACLE_HOME');
  end;
  result := s;
end;

function CheckLastDir(dir:String):String;
var
  l:Integer;
begin
  l := length(dir);
  result := dir;
  if l = 0 then exit; 
  if result[l] = '\' then
    result := copy(result,1,l - 1);
end;

procedure SetOracleEnv(Ora_dir:String;IsOCI:boolean=true;dbtype:Integer=0);
var
  LibHandle: THandle;
  P_device:TSetOracleEnv;
begin
  LibHandle := LoadLibrary(dllfilename);
  try
    if LibHandle <=32 then raise EDLLLoadError.Create('调用 '+dllfilename+' 失败！')
    else  begin
      @P_device := GetProcAddress(LibHandle, 'SetOracleEnv');
      if not (@P_device = nil) then
      begin
        try
         P_device(pchar(Ora_dir),IsOCI,dbtype);
        except
        end;
      end;
    end;
  finally
    FreeLibrary(LibHandle);
  end;
end;

procedure SaveErrorLog(msg:String);
var
  s,n:String;
  hLogFile:TextFile;
begin
  try
    n:='expback_error.log';
    n:=workdir+'\log\'+n;
    try
      AssignFile(hLogFile, n);
      If FileExists(n) Then
        Append(hLogFile)
      Else
        Rewrite(hLogFile);
      s := FormatDateTime('yyyy-MM-dd HH:mm:ss',now) + ',当前方案:'+Current_Scheme_Values[1]+',错误:'+msg;
      Writeln(hLogFile,s);
    finally
      CloseFile(hLogFile);
    end;
  except
  end;
end;

procedure SetTheItems(items:TStrings;value:Array of String);
var
  i:Integer;
begin
  items.Clear;
  for i := 0 to length(value) - 1 do
  begin
    items.Add(value[i]);
  end;
end;

function split(sour,sub:String):TArray;
var
st:TStringList;
i,count:integer;
begin
  st:=TStringList.Create;
  try
    st.Text := StringReplace(sour,sub,#13,[rfReplaceAll]);
    count := st.Count;
    setlength(result,count);
    for i:=0 to count-1 do
    begin
      result[i]:=st.Strings[i];
    end;
  finally
    st.Free;
  end;
end;

function TestFTP(ftp_host, ftp_user, ftp_pass: String; ftp_port: Integer;passive:boolean=false):String;
  //xxy 2020-09-09 增加ftp测试
var
  LibHandle: THandle;
  P_device:TTestFTP;
  p:pchar;//xxy 2021-12-29
begin
  LibHandle := LoadLibrary(dllfilename);
  result := 'OK';
  try
    if LibHandle <=32 then raise EDLLLoadError.Create('调用 '+dllfilename+' 失败！')
    else  begin
      @P_device := GetProcAddress(LibHandle, 'TestFTP');
      if not (@P_device = nil) then
      begin
        try
         p := P_device(pchar(ftp_host),pchar(ftp_user),pchar(ftp_pass),ftp_port,passive);
         result := String(p);
        except  on e:Exception do
          result := '错误:'+e.Message;

        end;
      end;
    end;
  finally
    FreeLibrary(LibHandle);
  end;
end;

end.