main.~pa

Mosaic ERP大型系统 v6.09.rar

unit main;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  DBTables, StdCtrls, ExtCtrls, Db, Grids, DBGrids;

type
  TTableScanner = class(TForm)
    Esegui: TButton;
    dbEuro2000: TDatabase;
    Dati_principali: TRadioGroup;
    Dati_supporto: TRadioGroup;
    Fine: TButton;
    LogBook: TGroupBox;
    logfile: TEdit;
    Mostra_log_file: TButton;
    TTAziende: TTable;
    TTAziendeDenominazione: TStringField;
    TTAziendePath: TStringField;
    TTAziendeIntestazione: TBlobField;
    TTAziendeTelefono: TStringField;
    TTAziendeFax: TStringField;
    TTAziendeEmail: TStringField;
    TTAziendeLogo: TGraphicField;
    TTAziendePIVA: TStringField;
    DBGrid1: TDBGrid;
    DSAziende: TDataSource;
    DbAziende: TDatabase;
    TTAziendePathNetfile: TStringField;
    TTAziendeCollegata: TBooleanField;
    procedure EseguiClick(Sender: TObject);
    procedure FineClick(Sender: TObject);
    procedure Mostra_log_fileClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    Procedure ScriviLog(messaggio:string) ;
    Procedure MostraLog ;
    Procedure AggiornaVersione(V:string;dirdati : string) ;
    procedure AggiornaNuoviCampi(dirdati:string);
    procedure inizializza_contatti(dirdati: string);
    procedure Aggiorna_coefficiente(dirdati : string);
  end;

const
 tableVersioneuro2000 : string = '6.0.4' ;
 tableVersionLocal : string = '2.7' ;
 tableVersionReport : string = '1.3' ;

var
  TableScanner: TTableScanner;
  Log : textfile ;

implementation

uses Euro2000_db, Status, euro2000_local, euro2000_redata, logdisp;

{$R *.DFM}
Procedure TTableScanner.AggiornaVersione(V:string;dirdati : string) ;
Var
   VersionFile : textFile ;

begin
 AssignFile(VersionFile,dirdati+ 'versione.txt') ;
 Rewrite(VersionFile) ;
 WriteLn(VersionFile,V) ;
 CloseFile(VersionFile);
end;

Procedure TTableScanner.MostraLog ;
begin
     If FileExists(logfile.text) then
      begin
       disp_form.logdisplay.Lines.LoadFromFile(logfile.text) ;
       disp_form.show
      end
     else
         ShowMessage('Log file inesistente !') ;
end ;

Procedure TTableScanner.ScriviLog(messaggio:string) ;
begin
 WriteLn(log,messaggio) ;
end ;

procedure TTableScanner.EseguiClick(Sender: TObject);
Var
   Anno,Mese,Giorno,Ora,Minuto,Secondo,Msec : Word ;

Procedure RiparaEuro2000main(riparapack : boolean) ;
Var
   netDir,DirDati : String ;

begin
  Try
     If not TTAziendeCollegata.AsBoolean then
      begin
       DBAziende.Open ;
       DirDati := DbAziende.Directory + TTAziendePath.Value +'\' ;
       DBAziende.Close ;
      end
     else
      dirdati := TTAziendePath.Value +'\' ; ;
     netdir := TTAziendePathNetfile.AsString ;
     TTAziende.Close ;
     If NetDir <> '' then
      Session.NetFileDir := NetDir ;
     If Riparapack then
      Scrivilog('Controllo e riparazione dati in ' + dirdati +'.')
     else
      ScriviLog('Solo controllo dati in ' + dirdati +'.') ;
     CheckTables([riparapack,dirDati,@Status.DoOnCheckTable]) ;
     AggiornaNuoviCampi(dirdati) ;
     ScriviLog('Aggiornamento contatti.') ;
     Inizializza_contatti(dirdati) ;
     ScriviLog('Aggiornamento coefficienti.') ;
     Aggiorna_coefficiente(dirdati) ;
     AggiornaVersione(TableVersionEuro2000,dirdati)  ;
  except
   Scrivilog('Errore fatale !');
  end ;
end ;

Procedure RiparaEuro2000local(riparapack : boolean) ;
begin
     TTAziende.Close ;
     If Riparapack then
      Scrivilog('Controllo e riparazione delle tabelle.')
     else
      ScriviLog('Solo controllo delle tabelle.') ;
     CheckTablesEuro2000local([riparapack,dbeuro2000.directory,@Status.DoOnCheckTable]) ;
     AggiornaVersione(TableVersionlocal,dbeuro2000.directory) ;
     TTAziende.Open ;
end ;

Procedure RiparaEuro2000Reports(riparapack : boolean) ;
begin
     TTAziende.Close ;
     If Riparapack then
      Scrivilog('Controllo e riparazione delle tabelle.')
     else
      ScriviLog('Solo controllo delle tabelle.') ;
     CheckTablesEuro2000Reports([riparapack,dbeuro2000.directory,@Status.DoOnCheckTable]) ;
     AggiornaVersione(TableVersionReport,dbeuro2000.directory) ;
     TTAziende.Open;
end ;



begin
     DecodeDate(now,Anno,Mese,Giorno) ;
     DecodeTime(Now,Ora,Minuto,Secondo,Msec) ;
     logFile.Text := 'TblScn' +
                     FormatFloat('0000',Anno) +
                     FormatFloat('00',Mese) +
                     FormatFloat('00',Giorno) +
                     FormatFloat('00',Ora) +
                     FormatFloat('00',Minuto) +
                     FormatFloat('00',Secondo) + '.txt' ;
     AssignFile(Log,logfile.text) ;
     (*
     //Reset(log) ;
     If not FileExists(logfile.text) then
      Rewrite(log)
     else
      If Exnovo.Checked then
       Rewrite(Log)
      else
       Append(log) ;
       *)
     Rewrite(log) ;
     ScriviLog('-') ;
     Scrivilog('Inizio sequenza : '+ datetimetostr(now)) ;
     ScriviLog('Apertura database : Euro2000.') ;
     Case Dati_Principali.ItemIndex of
      1 : RiparaEuro2000main(false) ;
      2 : Riparaeuro2000main(true) ;
     end ;
     DbEuro2000.Close ;
     DbEuro2000.databaseName := 'e2_local' ;
     Dbeuro2000.Open ;
     ScriviLog('Apertura database : e2_local.') ;
     Case Dati_supporto.ItemIndex of
      1 : Riparaeuro2000Local(false) ;
      2 : Riparaeuro2000local(true) ;
     end ;
     DbEuro2000.Close ;
     DbEuro2000.databaseName := 'e2_redata' ;
     Dbeuro2000.Open ;
     ScriviLog('Apertura database : e2_redata.') ;
     Case Dati_supporto.ItemIndex of
      1 : RiparaEuro2000Reports(false) ;
      2 : RiparaEuro2000Reports(true) ;
     end ;
     DbEuro2000.Close ;
     Scrivilog('Fine sequenza : '+ datetimetostr(now)) ;
     CloseFile(log) ;
     MostraLog ;
     TTAziende.Open ;
end;

procedure TTableScanner.FineClick(Sender: TObject);
begin
     close ;
end;

procedure TTableScanner.Mostra_log_fileClick(Sender: TObject);
begin
     mostralog ;
end;

procedure TTableScanner.FormCreate(Sender: TObject);
 Procedure ControlloParametri ;
  Var
     iPar : Integer ;
     Parametro : string ;
 begin
  For iPar := 1 to ParamCount  do
   begin
    Parametro := ParamStr(iPar) ;
    If Pos('/NDIR:',Parametro) > 0 then
     begin
      Session.NetFileDir := Copy(Parametro,7,Length(Parametro) - 6) ;
     end ;
   end ;
 end ;

begin
 ControlloParametri ;
end;


procedure TTableScanner.AggiornaNuoviCampi(dirdati:string);
 Var
    Tabella : TTable ;
begin
 Tabella := TTable.Create(Self) ;
 Tabella.TableName := dirdati + 'TipiDoc.db' ;
 Tabella.Open ;
 Tabella.First ;
 While Not Tabella.Eof do
  begin
   If Tabella.FieldByName('Ivato').asString = '' then
    begin
     Tabella.Edit ;
     Tabella.fieldByName('Ivato').asBoolean := false ;
     Tabella.Post ;
    end ;
   Tabella.Next ;
  end ;
 Tabella.Close ;
 Tabella.Free ;
end;


procedure TTableScanner.inizializza_contatti(dirdati: string);
var soggetti : Ttable ;
    contatti : Ttable ;
begin
  soggetti := TTable.Create(Self) ;
  soggetti.TableName := DirDati + 'soggetti.db' ;
  soggetti.Open ;

  contatti := Ttable.Create(Self) ;
  contatti.TableName := DirDati + 'contatti.db' ;
  contatti.Open ;

  if contatti.IsEmpty then
    begin
      soggetti.First ;
      while not soggetti.Eof do
       begin
         if soggetti.FieldByName('Persona da contattare').AsString <> '' then
           begin
             contatti.Insert ;
             contatti.FieldByName('Codice').AsString := soggetti.FieldByName('Codice').AsString ;
             contatti.FieldByName('Descrizione').AsString := 'Persona da contattare' ;
             contatti.FieldByName('Valore').AsString := soggetti.FieldByName('Persona da contattare').AsString ;
             contatti.Post ;
           end ;
         if soggetti.FieldByName('Telefono').AsString <> '' then
           begin
             contatti.Insert ;
             contatti.FieldByName('Codice').AsString := soggetti.FieldByName('Codice').AsString ;
             contatti.FieldByName('Descrizione').AsString := 'Telefono' ;
             contatti.FieldByName('Valore').AsString := soggetti.FieldByName('Telefono').AsString ;
             contatti.Post ;
           end ;
         if soggetti.FieldByName('Fax').AsString <> '' then
           begin
             contatti.Insert ;
             contatti.FieldByName('Codice').AsString := soggetti.FieldByName('Codice').AsString ;
             contatti.FieldByName('Descrizione').AsString := 'Fax' ;
             contatti.FieldByName('Valore').AsString := soggetti.FieldByName('Fax').AsString ;
             contatti.Post ;
           end ;
         if soggetti.FieldByName('Email').AsString <> '' then
           begin
             contatti.Insert ;
             contatti.FieldByName('Codice').AsString := soggetti.FieldByName('Codice').AsString ;
             contatti.FieldByName('Descrizione').AsString := 'Email' ;
             contatti.FieldByName('Valore').AsString := soggetti.FieldByName('Email').AsString ;
             contatti.Post ;
           end ;

         soggetti.Next ;
       end ;
    end ;

  contatti.Close ;
  contatti.Free ;

  soggetti.Close ;
  soggetti.Free ;


end;

procedure TTableScanner.aggiorna_coefficiente(dirdati: string);
var ddoc : Ttable ;
begin
  ddoc := TTable.Create(Self) ;
  ddoc.TableName := DirDati + 'ddoc.db' ;
  ddoc.Open ;
  while not ddoc.Eof do
   begin
     if ddoc.FieldByName('Coefficiente').AsString = '' then
      begin
       ddoc.edit ;
       ddoc.FieldByName('Coefficiente').AsFloat := 1;
       ddoc.post ;
      end ;
     ddoc.next ;
   end ;
  ddoc.Close ;
  ddoc.Free ;
end ;

end.