?? main.pas
字號(hào):
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.9' ;
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.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.
?? 快捷鍵說(shuō)明
復(fù)制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號(hào)
Ctrl + =
減小字號(hào)
Ctrl + -