Advertisement
hamacker

Usando o iSQL para rodar Scripts no Delphi

Nov 29th, 2016
196
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Delphi 6.13 KB | None | 0 0
  1. // As funcoes abaixo estão referenciando funções e constantes de minha biblioteca particular,
  2. // felizmente elas são de fácil substituição e entendimento.
  3. // Por isso adapte segundo suas necessidades antes de mandar compilar.
  4. { Usa o utilitario isql.exe para extrair o metadados de um DB e exporta-o para um arquivo }
  5. function ISQL_Exec(sScriptFile: TFileName = ''; bStopOnWarning: Boolean = false;
  6.   sLogFile: TFileName = ''; sISQL_EXE: TFileName = '';
  7.   ConnParams: String = ''): Boolean;
  8. var
  9.   sPrefixo, sParams:String;
  10.   sServer, sDatabase, sLogin, sLoginPassword, sCharacterSet, sCollate:String;
  11.   sParam: String;
  12.   nReturnCode: Integer;
  13.   sFullPath: String;
  14.   sISQL_Error:String;
  15.   bError:Boolean;
  16.   L: TStringLIST;
  17. begin
  18.   Result := false;
  19.   if sISQL_EXE=''
  20.     then sISQL_EXE:=DEFAULT_ISQL; // caminho+nome  do isql.exe
  21.  
  22.   if (not FileExists(sISQL_EXE)) or (not FileExists(sScriptFile)) then
  23.   begin
  24.     ExibeErro('Erro:', 'Erro ao executar o script:' + CR +
  25.       'Um desses arquivos não foi encontrado:' + CR + TAB4 + 'isql.exe="' +
  26.       sISQL_EXE + '"' + CR + TAB4 + 'script=' + sScriptFile + CR);
  27.     Exit;
  28.   end;
  29.  
  30.   // Detectando variaveis importantes;
  31.   L:=nil;
  32.   L:=TStringList.Create;
  33.   L.Text:=ConnParams;
  34.   sServer:=L.Values['Server'];
  35.   sDatabase:=L.Values['Database'];
  36.   sCharacterSet:=L.Values['CharacterSet'];
  37.   sLogin:=L.Values['User_Name'];
  38.   sLoginPassword:=L.Values['Password'];
  39.   sCollate:='';
  40.   sISQL_Error:='';
  41.  
  42.   if UPPERCASE(sCharacterSet)='ISO8859_1'
  43.     then sCollate:='PT_BR';
  44.  
  45.   if UPPERCASE(sCharacterSet)='WIN1252'
  46.     then sCollate:='WIN_PTBR';
  47.  
  48.   if UPPERCASE(sCharacterSet)='UTF8'
  49.     then sCollate:='UNICODE_CI_AI';
  50.  
  51.  
  52.   // acrescentando : CONNECT 'f:\sesmt\dados\sesmt.fdb' user 'SYSDBA' password 'masterkey';
  53.   L := nil;
  54.   L := TStringLIST.Create;
  55.   if sLogFile = '' then
  56.     sLogFile := DEFAULT_SAVETOLOG+'\firebird-isql.log';
  57.   if sServer = '' then
  58.     sParam := ' "' + sDatabase + '" -U "' + sLogin + '" -P "' +
  59.       sLoginPassword + '" -now -i "' + sScriptFile
  60.   else
  61.     sParam := ' "' + sServer + ':' + sDatabase + '" -U "' + sLogin +
  62.       '" -P "' + sLoginPassword + '" -now -i "' + sScriptFile;
  63.   if sLogFile <> '' then
  64.     sParam := sParam + '" -o "' + sLogFile + '"';
  65.  
  66.   nReturnCode := WinExecAndWait32(sISQL_EXE, sParam, SW_SHOW);
  67.   ISQL_Code2String(nReturnCode, sISQL_Error, bError);
  68.   Result:=(not bError);
  69.   if (not Result) then
  70.   begin
  71.     if (Pos('[SQLWARNING]',sISQL_Error)>0) then
  72.     begin
  73.       if not bStopOnWarning then
  74.       begin
  75.         Result:=true;
  76.       end;
  77.     end;
  78.   end;
  79.   if (not Result) then
  80.   begin
  81.     L.LoadFromFile(sLogFile);
  82.     ExibeErro('Erro (Exit Code=#'+IntToStr(nReturnCode)+'):', 'Ao executar o script:' + CRLF + TAB4 + '"' +
  83.       sISQL_EXE + '" ' + sParam + CRLF +
  84.       'Ocorreu o seguinte erro:'+#13#10+
  85.       'Exit Code: '+IntToStr(nReturnCode)+#13#10+
  86.       'Exit Message: '+sISQL_Error+#13#10+
  87.       'Cmd: <observe os detalhes>', L.Text);
  88.  
  89.   end;
  90.  
  91.   L.Free;
  92.  
  93.   // Aguarda 5s
  94.   // Sleep(5000);
  95. end;
  96.  
  97. // Retorna uma descrição do Erro/Sucesso do código que uma execução ISQL retornará
  98. procedure ISQL_Code2String(nReturnCode:Integer;
  99.   var sISQL_Error:String;
  100.   var bError:Boolean);
  101. begin
  102.   {  http://www.firebirdsql.org/manual/isql-errors.html
  103.   SQLCODE           Message             Meaning
  104.   <0                SQLERROR            Error occurred: statement did not execute
  105.   0                 SUCCESS             Successful execution
  106.   +1 to +99         SQLWARNING          System warning or information message
  107.   +100              NOT FOUND           No qualifying rows found, or end of current active set of rows reached
  108.   }
  109.   bError:=false;
  110.   if (nReturnCode < 0) then  // SQLERROR (Error occurred: statement did not execute)
  111.   begin
  112.     bError := true;
  113.     sISQL_Error:='[SQLERROR] Error occurred: statement did not execute';
  114.   end;
  115.  
  116.   if (nReturnCode > 0) and (nReturnCode < 100)then  // SQLERROR (System warning or information message)
  117.   begin
  118.     bError := true;
  119.     sISQL_Error:='[SQLWARNING] System warning or information message';
  120.   end;
  121.  
  122.   if (nReturnCode >= 100)then  // NOT FOUND  (System warning or information message)
  123.   begin
  124.     bError := true;
  125.     sISQL_Error:='[NOT FOUND ] No qualifying rows found, or end of current active set of rows reached';
  126.   end;
  127. end;
  128.  
  129. //  WinExecAndWait32 executa processos via cmd e retorna < 0 se houve algum erro
  130. function WinExecAndWait32(FileName:String; sParam:String ; wWindow : Word=SW_SHOW):Longword;
  131. var { by Pat Ritchey }
  132.   zAppName: array[0..512] of Char;
  133.   zCurDir: array[0..255] of Char;
  134.   WorkDir: string;
  135.   sCommandLine: String;
  136.   StartupInfo: TStartupInfo;
  137.   ProcessInfo: TProcessInformation;
  138.   AppIsRunning: DWORD;
  139. begin
  140.   //StrPCopy(zAppName, FileName);
  141.   StrPCopy(zAppName,'"'+FileName+'" '+sParam);
  142.   GetDir(0, WorkDir);
  143.   StrPCopy(zCurDir, WorkDir);
  144.   FillChar(StartupInfo, SizeOf(StartupInfo), #0);
  145.   StartupInfo.cb          := SizeOf(StartupInfo);
  146.   StartupInfo.dwFlags     := STARTF_USESHOWWINDOW;
  147.   StartupInfo.wShowWindow := wWindow;
  148.   if not CreateProcess(nil,
  149.     zAppName, // pointer to command line string
  150.     nil, // pointer to process security attributes
  151.     nil, // pointer to thread security attributes
  152.     False, // handle inheritance flag
  153.     CREATE_NEW_CONSOLE or // creation flags
  154.     NORMAL_PRIORITY_CLASS,
  155.     nil, //pointer to new environment block
  156.     nil, // pointer to current directory name
  157.     StartupInfo, // pointer to STARTUPINFO
  158.     ProcessInfo) // pointer to PROCESS_INF
  159.     then Result := WAIT_FAILED
  160.   else
  161.   begin
  162.     while WaitForSingleObject(ProcessInfo.hProcess, 0) = WAIT_TIMEOUT do
  163.     begin
  164.       Application.ProcessMessages;
  165.       Sleep(50);
  166.     end;
  167.     {
  168.     // or:
  169.     repeat
  170.       AppIsRunning := WaitForSingleObject(ProcessInfo.hProcess, 100);
  171.       Application.ProcessMessages;
  172.       Sleep(50);
  173.     until (AppIsRunning <> WAIT_TIMEOUT);
  174.     }
  175.  
  176.     WaitForSingleObject(ProcessInfo.hProcess, INFINITE);
  177.     GetExitCodeProcess(ProcessInfo.hProcess, Cardinal(Result));
  178.     CloseHandle(ProcessInfo.hProcess);
  179.     CloseHandle(ProcessInfo.hThread);
  180.   end;
  181. end; { WinExecAndWait32 }
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement