mainunit.pas

一个简单的ORACLE 转换工具,可以解决不少实际问题哦

    if Constraints then Cmd := Cmd + ' Constraints=Y'
    else Cmd := Cmd + ' Constraints=N';

    if fcbIncType.ItemIndex = 0 then
      Cmd := Cmd + ' IncType=complete '
    else if fcbIncType.ItemIndex = 1 then
      Cmd := Cmd + ' IncType=incremental '
    else if fcbIncType.ItemIndex = 2 then
      Cmd := Cmd + ' IncType=cumulative ';

    fmeoExpSQL.Text := Cmd;

    //开始导出
    CoolTrayIcon.ShowBalloonHint('提示', Format('[%4.4d-%2.2d-%2.2d %2.2d:%2.2d:%2.2d]', [Year, Month, Day, Hour, Min, Sec]) +
       ' 开始备份数据......', bitInfo, 10);
    Application.ProcessMessages;  
    //运行导出命令
    RunCmdLine(Cmd, ExitCode, ErrMessage, OutMessage);
    //记录日志
    Application.ProcessMessages;
    ExpLogFile := ChangeFileExt(ExpOutFile, '.log');
    SL := TStringList.Create;
    try
      SL.Add('//********************** 导出命令行 *****************************//');
      SL.Add('');
      SL.Add(Cmd);
      SL.Add('');
      SL.Add('//********************** 命令行输出 *****************************//');
      SL.Add(OutMessage);
      SL.SaveToFile(ExpLogFile);
    finally
      FreeAndNil(SL);
    end;
    //****压缩文件的代码*******
    Application.ProcessMessages;
    if Ziped then
    begin
      ZipComponent.ArchiveFile := ChangeFileExt(ExpOutFile, '.zip');
      if FileExists(ZipComponent.ArchiveFile) then DeleteFile(ZipComponent.ArchiveFile);
      ZipComponent.ExcludeSpec.Clear();
      ZipComponent.FileSpec.Clear();
      ZipComponent.FileSpec.Add(ExpOutFile);
      ZipComponent.FileSpec.Add(ExpLogFile);
      ZipComponent.TempDir := OutDir;
      ZipComponent.Compress();
      if FileExists(ExpOutFile) then DeleteFile(ExpOutFile);
      if FileExists(ExpLogFile) then DeleteFile(ExpLogFile);
    end;
    //备份完成
    CoolTrayIcon.ShowBalloonHint('提示', Format('[%4.4d-%2.2d-%2.2d %2.2d:%2.2d:%2.2d]', [Year, Month, Day, Hour, Min, Sec]) +
       ' 数据备份完成！', bitInfo, 10);
  end;
end;


procedure TfrmMain.ReadConfig;
var
  IniFile: TIniFile;
begin
  FileHandle := FileOpen(ConfigFile,fmShareDenyNone);
  if FileHandle > 0 then
  try
    IniFile := TIniFile.Create(ConfigFile);
    ExpExeFile := IniFile.ReadString('Common', 'ExpExeFile', '');
    BakupFile := IniFile.ReadString('Common', 'BakupFile', '');
    UserName := IniFile.ReadString('Common', 'UserName', '');
    UserPassword := IniFile.ReadString('Common', 'UserPassword', '');
    UserService := IniFile.ReadString('Common', 'UserService', '');
    Grants := IniFile.ReadBool('Common', 'Grants', False);
    Full := IniFile.ReadBool('Common', 'Full', False);
    Ziped := IniFile.ReadBool('Common', 'Ziped', True);
    AutoNamed := IniFile.ReadBool('Common', 'AutoNamed', True); 
    RunTime := IniFile.ReadString('Common', 'RunTime', '01:00');
    Indexes := IniFile.ReadBool('Common','Indexes',False);
    Constraints := IniFile.ReadBool('Common','Constraints',False); 
  finally
    FreeAndNil(IniFile);
    CloseHandle(FileHandle);
  end;
end;

procedure TfrmMain.SetConfig(InMem: Boolean);
begin
  if InMem then
  begin
    ExpExeFile := EdtExpExeFile.Text;
    BakupFile := edtBakupPath.Text;
    UserName := fedtTimeUserName.Text;
    UserPassword := fedtTimerUserPass.Text;
    UserService := fedtTimerUserScv.Text;
    RunTime := Format('%2.2d:%2.2d:%2.2d',[HourOf(EdtRunTime.Time), MinuteOf(EdtRunTime.Time), SecondOf(EdtRunTime.Time)]);
    Grants := ChkGrants.Checked;
    Full := chkFullFile.Checked;
    Ziped := chkZIPFile.Checked;
    AutoNamed := ChkAutoNamed.Checked;
    Indexes   := chkIndexes.Checked;
    Constraints := chkConstraints.Checked;
  end
  else
  begin
    if ExpExeFile = '' then EdtExpExeFile.Text := GetOraleHome(True,'')
    else EdtExpExeFile.Text := ExpExeFile;
    edtBakupPath.Text := BakupFile;
    fedtTimeUserName.Text := UserName;
    fedtTimerUserPass.Text := UserPassword;
    fedtTimerUserScv.Text := UserService;
    EdtRunTime.Time := StrToTime(RunTime);
    ChkGrants.Checked := Grants;
    chkFullFile.Checked := Full;
    chkZIPFile.Checked := Ziped;
    ChkAutoNamed.Checked := AutoNamed;
    chkIndexes.Checked := Indexes;
    chkConstraints.Checked := Constraints;
  end;
end;

procedure TfrmMain.SysButtonMsg(var Msg: TMessage);
begin
   if (Msg.wParam = SC_CLOSE) or (Msg.wParam = SC_MINIMIZE) then Hide
  else inherited; // 执行默认动作
end;

procedure TfrmMain.WriteConfig;
var
  IniFile: TIniFile;
begin
  if FileExists(ConfigFile) then DeleteFile(ConfigFile);
  IniFile := TIniFile.Create(ConfigFile);
  try
    IniFile.WriteString('Common', 'ExpExeFile', ExpExeFile);
    IniFile.WriteString('Common', 'BakupFile', BakupFile);
    IniFile.WriteString('Common', 'UserName', UserName);
    IniFile.WriteString('Common', 'UserPassword', UserPassword);
    IniFile.WriteString('Common', 'UserService', UserService);       
    IniFile.WriteBool('Common', 'Grants', Grants);
    IniFile.WriteBool('Common', 'Full', Full);
    IniFile.WriteBool('Common', 'Ziped', Ziped);
    IniFile.WriteBool('Common', 'AutoNamed', AutoNamed);
    IniFile.WriteString('Common', 'RunTime', RunTime);
    IniFile.WriteBool('Common','Indexes',Indexes);
    IniFile.WriteBool('Common','Constraints',Constraints);
  finally
    FreeAndNil(IniFile);
  end;
end;

function TfrmMain.GetOraleHome(CanExp : Boolean;strStyle:string): String;
var
  Reg: TRegistry;
  KeysList,ValueNamesList : TStringList;
  OracleHomePath,ValueOracleHome : String;
  i,j:Integer;
  IniFile: TIniFile;
begin
  Result := '';
  Reg := TRegistry.Create;
  KeysList := TStringList.Create;
  ValueNamesList := TStringList.Create;
  try
    //9i处理方法
    Reg.RootKey := HKEY_LOCAL_MACHINE;
    if Reg.OpenKey('Software\Oracle', False) then
    begin
      {Reg.GetValueNames(ValueNamesList);
      for j := 0 to ValueNamesList.Count - 1 do
      if (ValueNamesList.Strings[j] = 'ORACLE_HOME') then
        ValueOracleHome := Reg.ReadString(Trim(ValueNamesList.Strings[j]));}
      ValueOracleHome := Reg.ReadString('ORACLE_HOME');
    end;
    Reg.CloseKey;
    //10g处理方法
    Reg.RootKey := HKEY_LOCAL_MACHINE;
    if Reg.OpenKey('Software\Oracle', False) then
    begin
      Reg.GetKeyNames(KeysList);
      for i := 0 to KeysList.Count -1 do
        if UpperCase(LeftStr(Trim(KeysList.Strings[i]),4))= 'KEY_' then OracleHomePath := UpperCase(Trim(KeysList.Strings[i]));//Oracle10g有这样的键值
      if Reg.KeyExists(OracleHomePath) = True then
      begin
        Reg.OpenKey(OracleHomePath,False);
        ValueOracleHome := Reg.ReadString('ORACLE_HOME');
      end;
    end;
    Reg.CloseKey;
    //读取INI文件
    if ValueOracleHome = '' then
    begin
      FileHandle := FileOpen(AppPath+'ExpProfile.ini',fmShareDenyNone);
      if FileHandle > 0 then
      try
        IniFile := TIniFile.Create(AppPath+'ExpProfile.ini');
        ValueOracleHome := IniFile.ReadString('Common', 'ExpExeFile', '');
      finally
          FreeAndNil(IniFile);
          CloseHandle(FileHandle);
      end;
    end;
    
    if CanExp = True then
        Result := ValueOracleHome + '\bin\EXP'+Trim(strStyle)+ '.exe'
    else if CanExp = False then
        Result := ValueOracleHome + '\bin\IMP'+Trim(strStyle)+'.exe';
  finally
    FreeAndNil(Reg);
    FreeAndNil(KeysList);
    FreeAndNil(ValueNamesList);
  end;
end;

procedure TfrmMain.RunCmdLine(const Cmd: String; var ExitCode: DWORD;
  var ErrMessage, OutMessage: String);
{
Cmd：外部控制台程序文件名，包含路径;
ExitCode：程序执行状态代码，如果成功，返回 0 ，否则非 0;
ErrMessage：执行出现错误时返回错误信息;
OutMessage：控制台输出信息
}
var
  HReadPipe, HWritePipe: THandle;
  SI: STARTUPINFO;
  SA: SECURITY_ATTRIBUTES;
  PI: PROCESS_INFORMATION;
  CchReadBuffer: DWORD;
  PChr: PChar;
  StrTemp: String;
  FileName: PChar;
begin
  FileName := AllocMem(Length(Cmd) + 1);
  StrPCopy(FileName, Cmd);
  PChr := AllocMem(5000);
  SA.nLength := SizeOf(SECURITY_ATTRIBUTES);
  SA.lpSecurityDescriptor := nil;
  SA.bInheritHandle := True;

  if CreatePipe(HReadPipe, HWritePipe, @SA, 0) = False then
  begin
    ErrMessage := 'Can not create pipe!';
    Exit;
  end;
  fillchar(SI, SizeOf(STARTUPINFO), 0);
  SI.cb := SizeOf(STARTUPINFO);
  SI.dwFlags := (STARTF_USESTDHANDLES or STARTF_USESHOWWINDOW);
  SI.wShowWindow := SW_HIDE;
  SI.hStdInput := GetStdHandle(STD_INPUT_HANDLE);
  SI.hStdOutput := HWritePipe;
  SI.hStdError := HWritePipe;


  if CreateProcess( nil, FileName, nil, nil, true, 0, nil, nil, SI, PI) = False  then
  begin
    ErrMessage := 'can not create process!';
    FreeMem(PChr);
    FreeMem(FileName);
    Exit;
  end;

  while (True) do
  begin
    if not PeekNamedPipe(HReadPipe, PChr, 1, @CchReadBuffer, nil, nil) then Break;
    if CchReadBuffer <> 0 then
    begin
      if ReadFile(HReadPipe, PChr^, 4096, CchReadBuffer, nil) = False then Break;
      PChr[CchReadBuffer] := Chr(0);
      StrTemp := PChr;
      OutMessage := OutMessage + StrTemp;
    end
    else if (WaitForSingleObject(PI.hProcess ,0) = WAIT_OBJECT_0) then Break;
    Sleep(100);
  end;

  PChr[CchReadBuffer] := Chr(0);
  OutMessage := OutMessage + PChr;
  GetExitCodeProcess(PI.hProcess, ExitCode);
  CloseHandle(HReadPipe);
  CloseHandle(PI.hThread);
  CloseHandle(PI.hProcess);
  CloseHandle(hWritePipe);
  FreeMem(PChr);
  FreeMem(FileName);
end;

procedure TfrmMain.WriteToFile(const FileName, Content: String);
var
  SL: TStringList;
begin
  SL := TStringList.Create;
  try
    SL.Text := Content;
    SL.SaveToFile(FileName);
  finally
    FreeAndNil(SL);
  end;
end;

procedure TfrmMain.BtnExpExeFileClick(Sender: TObject);
begin
   OpenDialog.Filter := 'EXE文件(*.EXE)|*.EXE';
  OpenDialog.FileName := EdtExpExeFile.Text;
  if OpenDialog.Execute and (OpenDialog.FileName <> '') then
  begin
    EdtExpExeFile.Text := OpenDialog.FileName;
  end;
end;

procedure TfrmMain.btnBakUpDClick(Sender: TObject);
begin
  OpenDialog.Filter := '所有文件(*.*)|*.*';
  OpenDialog.FileName := edtBakupPath.Text;
  if OpenDialog.Execute and (OpenDialog.FileName <> '') then
  begin
    edtBakupPath.Text := OpenDialog.FileName;
  end;
end;

procedure TfrmMain.BtnExpExeFileDClick(Sender: TObject);
begin
  EdtExpExeFile.Text := GetOraleHome(True,'');
end;

procedure TfrmMain.btnBakupClick(Sender: TObject);
begin
  edtBakupPath.Text := AppPath + 'bakup\EXP.dmp';
end;

procedure TfrmMain.FormShow(Sender: TObject);
begin
  AppPath := ExtractFilePath(Application.ExeName);
  SetWindowLong(Application.Handle, GWL_EXSTYLE, WS_EX_TOOLWINDOW); {不在任务栏显示}//
end;

procedure TfrmMain.FlatButton1Click(Sender: TObject);
begin
  SetConfig(True);
  WriteConfig;
  Timer2.Enabled := True;
end;

procedure TfrmMain.N3Click(Sender: TObject);
begin
  ConfigFile := AppPath +'ExpProfile.ini';
  ReadConfig;
  SetConfig(False);
  PageControl1.Pages[2].TabVisible := True;
  PageControl1.Pages[2].Visible := True;
  PageControl1.ActivePageIndex := 2;
end;

procedure TfrmMain.N4Click(Sender: TObject);
begin
  PageControl1.Pages[2].TabVisible := False;
  PageControl1.Pages[2].Visible := False;
  PageControl1.ActivePageIndex := 0;
  Timer2.Enabled := False;
end;

procedure TfrmMain.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  if PageControl1.ActivePageIndex = 0 then
    EndProcess('exp.exe')
  else if PageControl1.ActivePageIndex = 1 then
    EndProcess('imp.exe')
  else if PageControl1.ActivePageIndex = 2 then
    EndProcess('exp.exe');
  FreeAndNil(imgTemp);
end;

procedure TfrmMain.EndProcess(AExeName: string);
const
  PROCESS_TERMINATE=$0001;
var
  ExeFileName: String;
  ContinueLoop: BOOL;
  FSnapshotHandle: THandle;
  FProcessEntry32: TProcessEntry32;
begin
  ExeFileName := AExeName;
  FSnapshotHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
  FProcessEntry32.dwSize := Sizeof(FProcessEntry32);
  ContinueLoop := Process32First(FSnapshotHandle,FProcessEntry32);
  while integer(ContinueLoop) <> 0 do
  begin
    if ((UpperCase(ExtractFileName(FProcessEntry32.szExeFile)) = UpperCase(ExeFileName))
    or (UpperCase(FProcessEntry32.szExeFile) = UpperCase(ExeFileName))) then
    TerminateProcess(OpenProcess(PROCESS_TERMINATE, BOOL(0),FProcessEntry32.th32ProcessID), 0);
    ContinueLoop := Process32Next(FSnapshotHandle,FProcessEntry32);
 end;
end;

end.