Footman

[Guest]

De applicatie maakt gebruik van Paradox-tabellen! Geen Oracle-database! Minder slecht ...
Over het algemeen is de applicatie gecompileerd en uitgevoerd met enkele programmeerproblemen.
Ik heb een paar aanpassingen gemaakt om uit te voeren, volg de onderstaande lijst. Van wat ik zag, was de auteur echter niet erg voorzichtig, en andere toegangsovertredingsfouten probeerde waarschijnlijk toegang te krijgen tot objecten die nog niet waren gemaakt of gedupliceerd, enz.
Te veel onnodige code, waardoor de analyse in korte tijd gecompliceerd wordt.
Over het algemeen kan de applicatie worden uitgevoerd en had ik toegang tot de gegevensschermen, maar soms waren er fouten, het indexbestand van het bestand "tester08.db" was bijvoorbeeld beschadigd, waardoor een fout werd gesloten Het formulier. Daarna heb ik de gegevens opnieuw opgeslagen en ik denk dat de index was hersteld.
Het project is bijgevoegd. Zie het "fmMain" -formulier in het "OnCreate" -evenement. Waar ik wat code heb toegevoegd om hier op mijn systeem uit te voeren.
Zie ook het formulier "dboDatabase" waar ik de parameter voor het pad naar het gegevensbestand heb gewijzigd in:
path = 😧 \ RADRIOTests \ VCL_FOOTMAN_Delphi7 \ Data

 

TableNamePrefix het was nodig om deze regel toe te voegen omdat de applicatie niet correct de "prefix" in de naam van de tabellen gebruikte.
Dit is te zien op de regel: 120, unit fmdmbasic.pas

functie TBasicData.OpenDatabase (dbname: string): integer;
...
     frmMain.TableNamePrefix := Copy(frmMain.DatabaseName, 1, Length(frmMain.DatabaseName) - 4);

FormMain:

procedure TfrmMain.FormCreate(Sender: TObject);
begin
...
  // MY CHANGES HERE AND DATABASE COMPONENTS PARAMS "PATH=D:\RADRIOTests\VCL_FOOTMAN_Delphi7\Data"

  FDateFormat        := 'dd-mm-yyyy'; // ShortDateFormat; //'dd-mm-yyyy'; // for my test
  OpenDialog.InitialDir := 'D:\RADRIOTests\VCL_FOOTMAN_Delphi7\Data'; // for my test
  TableNamePrefix       := 'tester';                                  // for my tests

end; // FormCreate


----------------------------------
the files "Tester08" show error on "index file" = corrupted!

---------------
some errors on code = possible access violation in objects not created or duplicated

 

RAD STUDIO 10.3.3: SCREENSHOTS

   

 

Edited January 18, 2021 by Guest

[Guest]

het "TBM" -bestand is een tekstbestand met een definitie die wordt gebruikt om de database te openen ... onnodig gebruik.

[Johnny Smash 0]

unit fmconsts;

interface

uses
  forms, classes, SysUtils;

const
  // do we use the debug log?
  USE_DEBUG_LOG = True;
  USE_DEBUG_LOG_FILE = False;

  // database messages
  CONFIRM_DELETE_DATA = 'The data is about to be deleted. Are you sure?';
  CONFIRM_APPLY_CHANGES = 'The data has changed. Save changes?';
  DELETE_OBJECT_REFERENCED = 'There are references to this object. It can''t be deleted.';
  VALUE_REQUIRED = 'Please enter a value for field ''%s''.';

  // constants for data objects
  SEASON_TABLE_NAME  = 'TESTER07.DB';
  SEASON_KEY_FIELD   = 'SeasonId';
  SEASON_NAME_FIELD  = 'SeasonName';
  SEASON_NEW_CAPTION = 'New season';
  SEASON_NEW_KEYNAME = 'Season no.';

  MATCH_TABLE_NAME  = 'TESTER15.DB';
  MATCH_KEY_FIELD   = 'MatchNr';
  MATCH_NAME_FIELD  = 'MatchId';
  MATCH_NEW_CAPTION = 'New match';
  MATCH_NEW_KEYNAME = 'Match no.';

  // pages on basic data form
  PAGE_TOPIC: array[0..8] of string =
   ('competition', 'team', 'player', 'coach', 'referee', 'stadium', 'country',
    'position', 'system');
  // positions on the field
  FIELD_POSITION: array[0..22] of string =
   ('Unknown', 'Defense', 'Goalkeeper', 'Sweeper', 'Left back', 'Left centre back',
    'Centre back', 'Right centre back', 'Right back', 'Midfield', 'Defensive midfield',
    'Left half', 'Centre half', 'Right half', 'Forward midfield', 'Forward',
    'Inside left', 'Inside right', 'Outside left', 'Left centre forward', 'Centre forward',
    'Right centre forward',  'Outside right');
  // known systems
  FIELD_SYSTEMS: array[0..23,0..5] of string =
   (('Year', 'K', 'D', 'M', 'F', 'Name'),
    ('1920', '1', '2', '3', '5', 'MM/ACH'),
    ('1930', '1', '3', '2', '5', 'WM/DCH'),
    ('1935', '1', '3', '3', '4', 'Verrou'),
    ('1941', '1', '3', '4', '3', 'Diagonal'),
    ('1984', '1', '3', '5', '2', 'sweeper/diamond/flat'),
    ('1950', '1', '4', '2', '4', 'sweeper/flat/flat'),
    ('1952', '1', '4', '2', '4', 'flat/flat/flat'),
    ('1942', '1', '4', '3', '3', 'Muralha'),
    ('1962', '1', '4', '3', '3', 'flat/flat/flat'),
    ('',     '1', '4', '3', '3', 'flat/dm/flat'),
    ('',     '1', '4', '3', '3', 'flat/fm/flat'),
    ('1974', '1', '4', '3', '3', 'sweeper/flat/flat'),
    ('',     '1', '4', '3', '3', 'sweeper/dm/flat'),
    ('',     '1', '4', '3', '3', 'sweeper/fm/flat'),
    ('1982', '1', '4', '4', '2', 'flat/diamond/flat'),
    ('1986', '1', '4', '4', '2', 'sweeper/diamond/flat'),
    ('',     '1', '4', '5', '1', 'flat/diamond/flat'),
    ('',     '1', '4', '5', '1', 'sweeper/diamond/flat'),
    ('1960', '1', '5', '2', '3', 'sweeper/flat/flat'),
    ('',     '1', '5', '3', '2', 'sweeper/flat/flat'),
    ('1984', '1', '5', '3', '2', 'sweeper/dm/flat'),
    ('',     '1', '5', '3', '2', 'sweeper/fm/flat'),
    ('',     '1', '5', '4', '1', 'sweeper/diamond/flat'));
  // descriptions of rounds
  ROUND_DESCR_001 = 'Not fixed';
  ROUND_DESCR_002 = 'Group round';
  ROUND_DESCR_014 = '1/64 finals';
  ROUND_DESCR_015 = '1/32 finals';
  ROUND_DESCR_016 = '1/16 finals';
  ROUND_DESCR_017 = '1/8 finals';
  ROUND_DESCR_018 = 'Quarter-finals';
  ROUND_DESCR_019 = 'Semi-finals';
  ROUND_DESCR_020 = 'Final';
  ROUND_DESCR_103 = 'Play for 3rd place';
  ROUND_DESCR_105 = 'Play for 5rd place';
  ROUND_DESCR_107 = 'Play for 7rd place';
  ROUND_DESCR_109 = 'Play for 9rd place';
  ROUND_DESCR_111 = 'Play for 11rd place';
  ROUND_DESCR_113 = 'Play for 13rd place';
  ROUND_DESCR_115 = 'Play for 15rd place';
  ROUND_DESCR_117 = 'Play for 17rd place';
  // error codes
  ERROR_NO_ERROR      =  0;
  ERROR_INITIALIZE    = -1;
  ERROR_EXECUTE       = -2;
  ERROR_FINALIZE      = -3;
  ERROR_OPEN_DATABASE = -4;
  ERROR_NO_RECORD     = -5;

type
  EFmException = class(Exception);

  EFmDatabaseException = class(EFmException);

  EFmDbInsufficientParameters = class(EFmDatabaseException);

  EFmDbIntegrityViolation = class(EFmDatabaseException);

  EFmDbFieldException = class(EFmDatabaseException)
  private
    FFieldName: string;
  public
    constructor Create(const Msg, aFieldName: String); {override;}
    property FieldName: string read FFieldName write FFieldName;
  end;

  EFmDbFieldRequired = class(EFmDbFieldException);

  // query sort procedure types
  TfgSortType = (stByName, stByCountry, stDontCare);
  TfgNational = (inDontCare, inYes, inNo);
  TSortProcedure = procedure (SortType: TfgSortType; IsNational: TfgNational) of object;
  // types for basic data pagecontrol
  TPageNumber = Byte;
  TExternalPages = set of TPageNumber;
  TIdForm = (ifCompetition, ifTeam, ifPlayer, ifCoach, ifReferee, ifStadium, ifCountry);
  TfvgFormState = (fsUnknown, fsBrowsing, fsEditing, fsInserting);
  TOwnEditForm = class(TForm)
  private
    FCurrentRecordId: integer;
    FFormState: TfvgFormState;
    constructor Create(AOwner: TComponent); override;
    procedure SetFormstate(Value: TfvgFormState);
  public
    procedure InitializeForm; dynamic;
    procedure UpdateFormState; dynamic;
    property FormState: TfvgFormState read FFormState write SetFormstate;
    property CurrentRecordId: integer read FCurrentRecordId write FCurrentRecordId; // key of current season
  end;

implementation

//__________________________________________________________________________________________
constructor EFmDbFieldException.Create(const Msg, aFieldName: String);
begin
  {inherited Create(Msg);}
  Message := Msg;

  FFieldName := aFieldName;
end;

//__________________________________________________________________________________________
constructor TOwnEditForm.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  //FCurrentRecordId := -1;
  //FFormState := fsBrowsing;
end; // Create

//__________________________________________________________________________________________
procedure TOwnEditForm.SetFormstate(Value: TfvgFormState);
begin
  if Value <> FFormState then
  begin
    FFormState := Value;
    UpdateFormState;
  end;
end; // SetFormstate

//__________________________________________________________________________________________
procedure TOwnEditForm.InitializeForm;
begin
  //
end; // InitializeForm

//__________________________________________________________________________________________
procedure TOwnEditForm.UpdateFormState;
begin
  //
end; // UpdateFormState

end.

 

[Johnny Smash 0]

unit fNewKeyInteger;

interface

uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, StdCtrls, ExtCtrls;

type
  TfrmNewKeyInteger = class(TForm)
    pnlData: TPanel;
    pnlCommands: TPanel;
    pnlSluiten: TPanel;
    cmdOk: TButton;
    cmdAnnuleer: TButton;
    lblKeyName: TLabel;
    txtNieuweKey: TEdit;
    procedure FormActivate(Sender: TObject);
    procedure cmdOkClick(Sender: TObject);
  private
    { Private declarations }
    function GetNieuweKey: integer;
    procedure SetNieuweKey(aValue: integer);
    procedure SetKeyName(aValue: string);
  public
    { Public declarations }
    property NieuweKey: integer read GetNieuweKey write SetNieuweKey;
    property KeyName: string write SetKeyName;
  end;

implementation

{$R *.DFM}

uses
  fmConsts;

procedure TfrmNewKeyInteger.FormActivate(Sender: TObject);
begin
  txtNieuweKey.SetFocus;
  txtNieuweKey.Text := '';
end;

function TfrmNewKeyInteger.GetNieuweKey: integer;
begin
  Result := StrToIntDef(txtNieuweKey.Text, 0);
end;

procedure TfrmNewKeyInteger.SetNieuweKey(aValue: integer);
begin
  txtNieuweKey.Text := IntToStr(aValue);
end;

procedure TfrmNewKeyInteger.SetKeyName(aValue: string);
begin
  lblKeyName.Caption := aValue;
end;

procedure TfrmNewKeyInteger.cmdOkClick(Sender: TObject);
begin
  if txtNieuweKey.Text <> '' then
    begin
      if (StrToIntDef(txtNieuweKey.Text, 0) > 0) then
        ModalResult := mrOk
      else
        begin
          MessageDlg('Please enter a positive number', mtError, [mbOk], 0);
          txtNieuweKey.SetFocus;
        end;
    end
  else
  begin
    Messagedlg(Format(VALUE_REQUIRED, [lblKeyName.Caption]), mtError, [mbOk], 0);
    txtNieuweKey.SetFocus;
  end;
end;

end.

 

[Johnny Smash 0]

unit dstat;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Db, DBTables, Wwquery;

type
  TdtmStat = class(TDataModule)
    qryMatch: TwwQuery;
    qryMatchSelection: TwwQuery;
    qryMatchEvents: TwwQuery;
    procedure dtmStatDestroy(Sender: TObject);
  private
    FDatabase: TDatabase;
  public
    procedure SetDatabaseToUse(aDatabase: TDatabase);
    procedure UpdateQueries(aPrefix: string);
    procedure CloseQueries;
  end;

var
  dtmStat: TdtmStat;

implementation

{$R *.DFM}

uses
  sqlconst;

//__________________________________________________________________________________________
procedure TdtmStat.SetDatabaseToUse(aDatabase: TDatabase);
begin
  FDatabase := aDatabase;
  qryMatch.DatabaseName := FDatabase.DatabaseName;
  qryMatchSelection.DatabaseName := FDatabase.DatabaseName;
  qryMatchEvents.DatabaseName := FDatabase.DatabaseName;
end; // SetDatabaseToUse

//__________________________________________________________________________________________
procedure TdtmStat.UpdateQueries(aPrefix: string);
begin
  UpdateSqlPrefixes(qryMatch.SQL, aPrefix);
  UpdateSqlPrefixes(qryMatchSelection.SQL, aPrefix);
  UpdateSqlPrefixes(qryMatchEvents.SQL, aPrefix);
  // en bereid de queries voor
  qryMatch.Prepare;
  qryMatchSelection.Prepare;
  qryMatchEvents.Prepare;
end; // UpdateQueries

//__________________________________________________________________________________________
procedure TdtmStat.dtmStatDestroy(Sender: TObject);
begin
  // unprepare de queries
  if qryMatch.Prepared then
    qryMatch.UnPrepare;
  if qryMatchSelection.Prepared then
    qryMatchSelection.UnPrepare;
  if qryMatchEvents.Prepared then
    qryMatchEvents.UnPrepare;
  // en sluit ze
  qryMatch.Close;
  qryMatchSelection.Close;
  qryMatchEvents.Close;
end; // dtmStatDestroy

//__________________________________________________________________________________________
procedure TdtmStat.CloseQueries;
begin
  qryMatch.Close;
  qryMatchSelection.Close;
  qryMatchEvents.Close;
  // unprepare de queries
  if qryMatch.Prepared then
    qryMatch.UnPrepare;
  if qryMatchSelection.Prepared then
    qryMatchSelection.UnPrepare;
  if qryMatchEvents.Prepared then
    qryMatchEvents.UnPrepare;
end; // CloseQueries

end.

 

[Johnny Smash 0]

unit sqlconst;

interface

uses
  classes, SysUtils;

const
  SQL_MATCH_COUNT = 29;
  SQL_MATCH : array[0..SQL_MATCH_COUNT -1] of string =
    ('SELECT Match.SeasonId, Match.RoundNr, Match.GroupNr, Match.MatchNr, Match.MatchId,',
     '   Match.Return, Match.Team1Id, Match.Team2Id, Match.Winner, Match.MatchDateTime,',
     '   Match.InTabelle, Match.StadiumId, Match.RefereeId, Match.Text, Match.Visitors, Match.Coach1Id,',
     '   Match.Coach2Id, Match.SpToreStr1, Match.SpToreStr2, Match.SpPunkte1, Match.SpPunkte2,',
     '   Match.SpPunkte3, Match.SpPunkte4, Match.SpBilanz1, Match.SpBilanz2, Match.SpTore1,',
     '   Match.SpTore2, Match.SpTore3, Match.SpTore4, Match.StaWertung, Match.SchiriKosten,',
     '   Match.SelectFeld, Team1.TeamId tm1TeamId, Team1.TeamName tm1TeamName, Team1.Country tm1Country,',
     '   Team2.TeamId tm2TeamId, Team2.TeamName tm2TeamName, Team2.Country tm2Country,',
     '   Coach1.CoachId co1CoachId, Coach1.FullName co1FullName, Coach1.Nationality co1Nationality,',
     '   Coach2.CoachId co2CoachId, Coach2.FullName co2FullName, Coach2.Nationality co2Nationality,',
     '   Referee.RefereeId refRefereeId, Referee.FullName refFullName, Referee.Nationality, Stadium.StadiumId staStadiumId,',
     '   Stadium.FullName staFullName, Stadium.Capacity staCapacity, Stadium.Country staCountry',
     'FROM "PREFIX15.DB" Match',
     '   LEFT OUTER JOIN "PREFIX01.DB" Team1',
     '   ON  (Match.Team1Id = Team1.TeamId)',
     '   LEFT OUTER JOIN "PREFIX01.DB" Team2',
     '   ON  (Match.Team2Id = Team2.TeamId)',
     '   LEFT OUTER JOIN "PREFIX03.DB" Coach1',
     '   ON  (Match.Coach1Id = Coach1.CoachId)',
     '   LEFT OUTER JOIN "PREFIX03.DB" Coach2',
     '   ON  (Match.Coach2Id = Coach2.CoachId)',
     '   LEFT OUTER JOIN "PREFIX04.DB" Referee',
     '   ON  (Match.RefereeId = Referee.RefereeId)',
     '   LEFT OUTER JOIN "PREFIX05.DB" Stadium',
     '   ON  (Match.StadiumId = Stadium.StadiumId)',
     'WHERE   (Match.SeasonId = :prmSeasonId)',
     '   AND  (Match.RoundNr = :prmRoundNr)',
     '   AND  (Match.GroupNr = :prmGroupNr)',
     '   AND  (Match.MatchNr = :prmMatchNr)');

  SQL_MATCH_SELECTION_COUNT = 5;
  SQL_MATCH_SELECTION : array[0..SQL_MATCH_SELECTION_COUNT -1] of string =
    ('select *',
     'from "PREFIX16.db" pim, "PREFIX02.db" pla',
     'where (pim.PlayerId = pla.PlayerId)',
     '   and (MatchId = :prmMatchId)',
     'order by PlaysForTeam, BackNr');

  SQL_MATCH_EVENTS_COUNT = 6;
  SQL_MATCH_EVENTS : array[0..SQL_MATCH_EVENTS_COUNT -1] of string =
    ('SELECT Goal.MatchId, Goal.PlayerId, Goal.GoalMinute, Goal.GoalForTeam, Goal.OwnGoal, Goal.Comment, Player.FullName',
     'FROM "PREFIX17.DB" Goal',
     '   LEFT OUTER JOIN "PREFIX02.DB" Player',
     '   ON  (Goal.PlayerId = Player.PlayerId)',
     'WHERE  (Goal.MatchId = :prmMatchId)',
     'ORDER BY Goal.GoalMinute');


procedure UpdateSqlPrefixes(SQL: TStrings; Prefix: string);

implementation

procedure UpdateSqlPrefixes(SQL: TStrings; Prefix: string);
var
  Regel: integer;
  p:     integer;
begin
  for Regel := 0 to SQL.Count - 1 do
  begin
    p := Pos('PREFIX', SQL[Regel]);
    while (p > 0) do
    begin
      SQL[Regel] := Copy(SQL[Regel], 1, p-1) + Prefix + Copy(SQL[Regel], p + 6, Length(SQL[Regel]) - p - 5);
      p := Pos('PREFIX', SQL[Regel]);
    end;
  end;
end; // UpdateSqlPrefixes

end.

 

[Lars Fosdal 1792]

I'd suggest using GitHub to share code.  Makes it easy to access, easy to contribute to, and prevents walls of code in a small forum.

[Johnny Smash 0]

Quote

Please try to use the English language. And please post longer code-segments as file-attachments.

Ja, Lars. Daniel advarede mig allerede (see qote). Men jeg venter på, at emailx45 skal svare mig.

Han arbejder på et problem. Snart slutter dette indlæg alligevel.

[Guest]

21 hours ago, Johnny Smash said:

unit fmconsts;
...
end.

 

• Creëren van "constanten", aangepaste klassen voor onder andere uitzonderingen, om het gebruik later te vergemakkelijken ...
  Allemaal echt niet nodig. Een teveel aan code, waarvan er vele al bestaan in Delphi zelf ... zoals in veel andere onderdelen van het project.

[Guest]

21 hours ago, Johnny Smash said:

unit fNewKeyInteger;
...
uses
  fmConsts; // met behulp van de definities die zijn gemaakt in de eenheid "consts"
procedure TfrmNewKeyInteger.FormActivate(Sender: TObject); // legt de focus op de gegeven component
function TfrmNewKeyInteger.GetNieuweKey: integer; // om de volgende sleutel te krijgen, mogelijk voor het nieuw ingevoegde record
procedure TfrmNewKeyInteger.SetNieuweKey(aValue: integer); // het definiëren van de volgende sleutel, mogelijk voor het nieuw ingevoegde record
procedure TfrmNewKeyInteger.SetKeyName(aValue: string); // het 'bijschrift' van het 'label' definiëren
procedure TfrmNewKeyInteger.cmdOkClick(Sender: TObject); // een controle of een waarde wordt geaccepteerd, anders vragen om opnieuw in te voeren
...
end.

 

 

[Guest]

21 hours ago, Johnny Smash said:

unit dstat;
...
procedure TdtmStat.SetDatabaseToUse(aDatabase: TDatabase); // definieert de "database" die moet worden gebruikt ... of het pad, in het geval van "Paradox" -tabellen
procedure TdtmStat.UpdateQueries(aPrefix: string); // hier voert het een onderhoud uit in de tekst van de "querys" van de component "UpdateSQL", met vermelding van het "Prefix" van de tabellen ... je zult iets als dit zien: 'Tester' + '00 .db "- 18 bestanden worden gebruikt (00 tot 17 )
procedure TdtmStat.dtmStatDestroy(Sender: TObject); // voordat het object wordt vernietigd en de tafels worden gesloten, wordt een "onvoorbereid" - onnodig onvoorbereid!
procedure TdtmStat.CloseQueries; // sluit de "querys". OK!
...
end.

 

 

[Guest]

21 hours ago, Johnny Smash said:

unit sqlconst;
...
end.

 

hier bevestigen we over codering! zie de eenheid "Consts" - praktisch een herhaling

[Johnny Smash 0]

Welcome back. Now I have a piece of source code, which is bothering me. Compiling is hold on this part:

with grdSelection1 do
    begin
      Selected.Clear;
      Selected.Add('BackNr' + #9 + '3'+ #9 + 'Nr');
      Selected.Add('FullName' + #9 + '20'+ #9 + 'Player');
      Selected.Add('MinutesInMatch' + #9 + '3'+ #9 + 'Min');
      ApplySelected;
    end;

 

Delphi sees 'Selected, Clear, Add and ApplySelected' each as a "undeclared identifier". So what is going wrong?

Is an external component missing? Do I need to declare a variable? Does anybody have an idea, please? 

 

[Lars Fosdal 1792]

with is a horrific construct with loads of pitfalls.

Don't use it.

 

[Johnny Smash 0]

Clear Lars. But this is not my doing. It is the coding of somebody else. It is part of a program.

I am trying to change all the InfoPower components from Woll2Woll back to standard Delphi ones.

Delphi sees 'Selected, Clear, Add and ApplySelected' each as a "undeclared identifier" and halts.

What could be the cause of this error you think, please?

[Stano 143]

Since you are editing the code, what prevents you from getting rid of "with"? We don't even know what grdSelection1 is!

[Johnny Smash 0]

Well, Stano, grdselection1 and grdselection2 were both a TwwDBGrid (Woll2Woll). Now they are of TDBGrid.

[Stano 143]

So I put TDBGrid on the form. I do not use it. The LSP Insight offered - see picture. Selected is not there.

I'm a little surprised, because it's not hard to find out