Parametry pakowania tabeli w programie

0

Witam,
napisałem kod programu bazy danych w którym zawarta jest procedura pakowania tabel. Proszę rzucić okiem czy jest ona dobrze napisana. Pliki bazowe są napisane w formacie dbf Mam wielką nadzieję, że zainteresuje Was mnie mój problem i pomożecie mi go rozwiązać. Poniżej pozwoliłem sobie umieścić cały kod pas'a w celu pokazania szerszego problemu.

unit Arkusz;
interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Db, DBTables, Grids, DBGrids, Buttons, StdCtrls, ComCtrls, ExtCtrls,
  DBCtrls, ShellApi, DbiProcs, DbiTypes, DbiErrs, BDE;

type
  TForm1 = class(TForm)
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    TabSheet2: TTabSheet;
    TabSheet3: TTabSheet;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    GroupBox1: TGroupBox;
    GroupBox2: TGroupBox;
    Edit1: TEdit;
    RB1: TRadioButton;
    RB2: TRadioButton;
    SpeedButton1: TSpeedButton;
    SpeedButton2: TSpeedButton;
    BitBtn1: TBitBtn;
    BitBtn2: TBitBtn;
    BitBtn3: TBitBtn;
    DS1: TDataSource;
    DS2: TDataSource;
    Table1: TTable;
    Table2: TTable;
    BitBtn4: TBitBtn;
    Session1: TSession;
    Label1: TLabel;
    Timer1: TTimer;
    DBGrid1: TDBGrid;
    Table1ID: TSmallintField;
    Table1IMIE: TStringField;
    Table1NAZWISKO: TStringField;
    Table1ULICA: TStringField;
    Table1NR_DOMU: TStringField;
    Table1KOD: TStringField;
    Table1MIASTO: TStringField;
    Table1TEL_DOMOWY: TStringField;
    Table1KOMORKA: TStringField;
    Table1EMAIL: TStringField;
    Table1WWW: TStringField;
    Table1OPIS: TMemoField;
    Table1KRAJ: TStringField;
    Table1KIERUNKOWY: TStringField;
    Table2ID: TSmallintField;
    DBGrid2: TDBGrid;
    Table1tel: TStringField;
    DBNavigator1: TDBNavigator;
    DBMemo1: TDBMemo;
    BitBtn5: TBitBtn;

    procedure BitBtn4Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Edit1Change(Sender: TObject);
    procedure Edit1Click(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
    procedure SpeedButton2Click(Sender: TObject);
    procedure BitBtn1Click(Sender: TObject);
    procedure BitBtn2Click(Sender: TObject);
    procedure BitBtn3Click(Sender: TObject);
    procedure Table1CalcFields(DataSet: TDataSet);
    procedure PageControl1Change(Sender: TObject);
    procedure RB1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);

    procedure FormShow(Sender: TObject);
    procedure BitBtn5Click(Sender: TObject);
 
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

uses Nazwis;

{$R *.DFM}

procedure TForm1.BitBtn4Click(Sender: TObject);
var
  numBtn: Integer;
begin
numBtn:= Application.MessageBox('Napewno Kończysz ?',
'Zakończenie pracy',
MB_ICONQUESTION or MB_YESNO);
if (numBtn = IDYES) then
begin
ShowMessage('Hey to zamykamy program ;-)');

close 
end;
if (numBtn = IDNO) then
begin
ShowMessage(' Nie zamykam pracuj dalej ;-)');

end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
nazwisko:string[40];
begin
nazwisko:=InputBox('Wczytywanie nazwiska', 'Podaj nazwisko',' ');
IF Table1.Locate('Nazwisko',nazwisko,[loCaseInsensitive])
then
ShowMessage('Znalezione nazwisko '+Table1['Nazwisko'])
else
ShowMessage('Brak nazwiska '+ nazwisko);
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  sDir:string;
begin

    GetDir(0,sDir);

   { try
    CreateDirectory('\Dane',nil);
    Session1.AddStandardAlias('Alias',sDir+'\Dane','');
   except
      end;  }

Table1.DatabaseName:=sDir+'\Dane';
Table2.DatabaseName:=sDir+'\Dane';

Label1.Caption:='Aktualny czas - '+FormatDateTime('h:m:s',now);
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
Label1.Caption:='Aktualny czas - '+FormatDateTime('hhh:mmm:sss',now);
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Table1.Close;
Table2.Close;
end;

procedure TForm1.Edit1Change(Sender: TObject);
begin
if Edit1.Text='' then Table1.Filter:='' else
  begin
   if RB1.Checked then  Table1.Filter:='NAZWISKO =' + QuotedStr(Edit1.Text + '*');
   if RB2.Checked then  Table1.Filter:='MIASTO =' + QuotedStr(Edit1.Text + '*');
  end;
end;

procedure TForm1.Edit1Click(Sender: TObject);
begin
if Table1.Filter<>'' then
  begin
    Edit1.Text:='';
    Table1.Filter:='';               // wyłącza filtr
  end;
ActiveControl:=Edit1;
end;

procedure TForm1.SpeedButton1Click(Sender: TObject);
begin
Table1.IndexName:='NAZWISKO';
end;

procedure TForm1.SpeedButton2Click(Sender: TObject);
begin
Table1.IndexName:='MIASTO';
end;

procedure TForm1.BitBtn1Click(Sender: TObject);
var
  Nazwisko:TNazwisko;
begin
Nazwisko:=TNazwisko.Create(Self);
Nazwisko.BitBtn1.Tag:=10;
Nazwisko.ShowModal;
Nazwisko.Free;

end;

procedure TForm1.BitBtn2Click(Sender: TObject);
var
  Nazwisko:TNazwisko;
begin
Nazwisko:=TNazwisko.Create(Self);

Nazwisko.BitBtn1.Tag:=20;

Nazwisko.E1.Text:=Table1NAZWISKO.AsString;
Nazwisko.E2.Text:=Table1IMIE.AsString;
Nazwisko.E3.Text:=Table1ULICA.AsString;
Nazwisko.E4.Text:=Table1NR_DOMU.AsString;
Nazwisko.E5.Text:=Table1KOD.AsString;
Nazwisko.E6.Text:=Table1MIASTO.AsString;
Nazwisko.E7.Text:=Table1KRAJ.AsString;
Nazwisko.E8.Text:=Table1KIERUNKOWY.AsString;
Nazwisko.E9.Text:=Table1TEL_DOMOWY.AsString;
Nazwisko.E10.Text:=Table1KOMORKA.AsString;
Nazwisko.E11.Text:=Table1EMAIL.AsString;
Nazwisko.E12.Text:= Table1WWW.AsString;
Nazwisko.Memo1.Text:=Table1OPIS.AsString;

Nazwisko.ShowModal;
Nazwisko.Free;

end;

procedure TForm1.BitBtn3Click(Sender: TObject);
begin
if Application.MessageBox('Usuwasz wpis z bazy danych. Procedura ta jest nieodwracalna. Czy chcesz kontynuowac?',
'KOMUNIKAT', MB_ICONQUESTION or MB_YESNO)=idYes then Table1.Delete;
end;

procedure TForm1.Table1CalcFields(DataSet: TDataSet);
var
  a,b:string;
begin
if Table1KIERUNKOWY.AsString='' then
  begin
    a:='';
    b:='';
  end else
    begin
      a:='(0- ';
      b:=')  ';
    end;

Table1TEL.AsString:=a+Table1KIERUNKOWY.AsString+b+Table1TEL_DOMOWY.AsString;
end;

procedure TForm1.PageControl1Change(Sender: TObject);
begin
if Table1.Filter<>'' then
  begin
    Edit1.Text:='';
    Table1.Filter:='';               // wyłącza filtr
  end;

if PageControl1.ACtivePage=TabSheet2 then ActiveControl:=Edit1;
end;

procedure TForm1.RB1Click(Sender: TObject);
begin
ActiveControl:=Edit1;
end;

procedure TForm1.Button2Click(Sender: TObject);
var
miasto:string[40];
begin
miasto:=InputBox('Wczytywanie miasta', 'Podaj nazwę miasta',' ');
IF Table1.Locate('Miasto',miasto,[loCaseInsensitive])
then
ShowMessage('Znalezione miasto '+Table1['Miasto'])
else
ShowMessage('Nie znaleziono miasta '+ miasto);

end;

procedure TForm1.Button3Click(Sender: TObject);
var
komorka:string[20];
begin
komorka:=InputBox('Wczytywanie komorki', 'Podaj numer Telefonu komórkowego',' ');
IF Table1.Locate('Komorka',komorka,[loCaseInsensitive])
then
ShowMessage('Znaleziony numer Telefonu komórkowego '+Table1['komorka'])
else
ShowMessage('Nie znaleziono numeru Telefonu komórkowego '+ komorka);

end;

procedure TForm1.Button4Click(Sender: TObject);
var
tel_domowy:string[20];
begin
tel_domowy:=InputBox('Wczytywanie telefonu domowego', 'Podaj numer Telefonu domowego',' ');
IF Table1.Locate('Tel_domowy',tel_domowy,[loCaseInsensitive])
then
ShowMessage('Znaleziony numer Telefonu domowego '+Table1['tel_domowy'])
else
ShowMessage('Nie znaleziono numeru Telefonu domowego '+ tel_domowy);

end;

procedure TForm1.BitBtn5Click(Sender: TObject);
begin
ShellExecute(Handle, 'open', PChar(ExtractFilePath(Application.ExeName)+'\pomoc.html'), nil, nil, SW_SHOWNORMAL);
end;

// Pack a Paradox or dBASE table
// The table must be opened execlusively before calling this function...
procedure PackTable (Table1 :TTable);
var
  Props       : CURProps;
  hDb         : hDBIDb;
  TableDesc : CRTblDesc;
begin
  if Table1.Active = False
     then raise EDatabaseError.Create ('Table must be opened to pack');
  if Table1.Exclusive = False
     then raise EDatabaseError.Create ('Table must be opened exclusively to pack');
  Check (DbiGetCursorProps (Table1.Handle, Props));
  if Props.szTableType = szPARADOX
     then begin
            FillChar (TableDesc, sizeof(TableDesc), 0);
            Check (DbiGetObjFromObj(hDBIObj(Table1.Handle), objDATABASE, hDBIObj(hDb)));
            StrPCopy (TableDesc.szTblName, Table1.TableName);
            StrPCopy (TableDesc.szTblType, Props.szTableType);
            TableDesc.bPack:=True;
            Table1.Close;
            Check (DbiDoRestructure(hDb, 1, @TableDesc, nil, nil, nil, FALSE));
          end
     else if Props.szTableType = szDBASE
             then Check (DbiPackTable (Table1.DBHandle, Table1.Handle, nil, szDBASE, TRUE))
             else raise EDatabaseError.Create ('Table must be either of Paradox or dBASE type to pack');
  Table1.Open;
end;


procedure TForm1.FormShow(Sender: TObject);
begin
Table1.Open;
Table2.Open; 
end;

end.

Serdecznie pozdrawiam i proszę o wyrozumiałość

0

kedlaw07 napisał(a)

Poniżej pozwoliłem sobie umieścić cały kod pas'a w celu pokazania szerszego problemu.
ale jakiego problemu bo ja tu ani szerszego ani węższego problemu nie widzę. Nie działa Ci coś czy tak po prostu chciałeś się pochwalić kodem...

0

Witam,
Kod wylistowałem w celu spojrzenia na problem, a nie po to żeby się nim chwalić. Chodzi mi o procedurę pakowania pliku bazy danych dbf, który posiadam w swoim programie. Nie wiem czy jest dobrze "opisana"

Serdecznie pozdrawiam i proszę o wyrozumiałość
Waldi

0

zapytam jeszcze raz i oczekuję odpowiedzi tak albo nie - działa Ci ta porcedura czy masz z nią jakiś problem?
BTW stwierdzenie

Nie wiem czy jest dobrze "opisana"
nic nie mówi

0

Witam,
wielkość pliku z danymi nazwiska.dbf wynosi 6,9 kb (29 rekordów). Po wykasowaniu ich wielkość pliku z danymi 8.0 kb i 5 rekordów w bazie. Numer kolejny jest nadawany przy wpisie. Ostatni rekord przed kasowaniem był 29. Zacząłem dopisywać kolejne rekordy i program w pliku nazwiska.dbf pokazuje pierwszy rekord oznaczony numerem 30. Według mnie to chyba nie działa, bo powinien na wykasowane miejsca nadpisywać nowe dane a w teraz tak nie robi. Pliki są utworzone w DBASE.
Serdecznie pozdrawiam i proszę o wyrozumiałość
Waldi

0

pakowanie tabeli to FIZYCZNE USUWANIE USUNIĘTYCH REKORDÓW.
Co to jest i skąd go wziąłeś "rekord oznaczony numerem".
AUTOINC z założenia choćby się świat kończył nie ma prawa nadać numeru, któy już kiedyś nadał (pomijając kwestię przekręcenie licznika)

0

Witam,
mam tak:
tabela.dbf -> nazwiska
numer kolejny to 20 - do 29 id 10 do 19 imię, nazwisko i reszta pól czyli łącznie 10 rekordów. Z tego co gdzieś czytałem to pakowanie tabel pozwala nadpisywać na rekordy które wcześniej usunięto nowe dane. Żeby nie powiększać zbytnio plików bazowych dbf.
Serdeczine pozdrawiam i proszę o wyrozumiałość
Waldi

Parametry pakowania tabeli w programie

kedlaw07 napisał(a)

1 użytkowników online, w tym zalogowanych: 0, gości: 1

Praca dla programistów

Forum dyskusyjne

Sprawy administracyjne

O nas

Skontaktuj się z nami