Subversion Repositories oidplus

Rev

Rev 233 | Go to most recent revision | Show entire file | Regard whitespace | Details | Blame | Last modification | View Log | RSS feed

Rev 233 Rev 234
Line 10... Line 10...
10 
 
 10 
 
11 
type
 11 
type
12 
  TForm1 = class(TForm)
 12 
  TForm1 = class(TForm)
13 
    Outline1: TOutline;
 13 
    Outline1: TOutline;
14 
    Notebook1: TNotebook;
 14 
    Notebook1: TNotebook;
15 
    Label1: TLabel;
 - 
 
16 
    Label3: TLabel;
 - 
 
17 
    Label4: TLabel;
 - 
 
18 
    Label5: TLabel;
 - 
 
19 
    Label6: TLabel;
 - 
 
20 
    Label7: TLabel;
 - 
 
21 
    Label15: TLabel;
 - 
 
22 
    Edit3: TEdit;
 - 
 
23 
    Memo1: TMemo;
 15 
    Memo1: TMemo;
24 
    Edit4: TEdit;
 - 
 
25 
    CheckBox1: TCheckBox;
 - 
 
26 
    ComboBox1: TComboBox;
 - 
 
27 
    Edit5: TEdit;
 - 
 
28 
    Edit6: TEdit;
 - 
 
29 
    ListBox1: TListBox;
 - 
 
30 
    Edit7: TEdit;
 - 
 
31 
    Button1: TButton;
 - 
 
32 
    Button3: TButton;
 - 
 
33 
    Button2: TButton;
 - 
 
34 
    Button4: TButton;
 - 
 
35 
    Edit1: TEdit;
 - 
 
36 
    Button6: TButton;
 - 
 
37 
    Label2: TLabel;
 16 
    Label2: TLabel;
38 
    Label8: TLabel;
 17 
    Label8: TLabel;
39 
    Label9: TLabel;
 18 
    Label9: TLabel;
40 
    Label10: TLabel;
 19 
    Label10: TLabel;
41 
    Label11: TLabel;
 20 
    Label11: TLabel;
Line 52... Line 31...
52 
    Button5: TButton;
 31 
    Button5: TButton;
53 
    Edit2: TEdit;
 32 
    Edit2: TEdit;
54 
    Label14: TLabel;
 33 
    Label14: TLabel;
55 
    Edit8: TEdit;
 34 
    Edit8: TEdit;
56 
    Button7: TButton;
 35 
    Button7: TButton;
- 
 
 36 
    Panel1: TPanel;
- 
 
 37 
    Label1: TLabel;
- 
 
 38 
    Label3: TLabel;
- 
 
 39 
    Label4: TLabel;
- 
 
 40 
    Label5: TLabel;
- 
 
 41 
    Label6: TLabel;
- 
 
 42 
    Label7: TLabel;
- 
 
 43 
    Edit3: TEdit;
- 
 
 44 
    Edit4: TEdit;
- 
 
 45 
    CheckBox1: TCheckBox;
- 
 
 46 
    ComboBox1: TComboBox;
- 
 
 47 
    Edit5: TEdit;
- 
 
 48 
    Edit6: TEdit;
- 
 
 49 
    ListBox1: TListBox;
- 
 
 50 
    Edit7: TEdit;
- 
 
 51 
    Button1: TButton;
- 
 
 52 
    Button3: TButton;
- 
 
 53 
    Panel2: TPanel;
- 
 
 54 
    Button2: TButton;
- 
 
 55 
    Button4: TButton;
- 
 
 56 
    Edit1: TEdit;
- 
 
 57 
    Button6: TButton;
- 
 
 58 
    Label15: TLabel;
57 
    procedure Outline1Change(Sender: TObject; Node: integer);
 59 
    procedure Outline1Change(Sender: TObject; Node: integer);
58 
    procedure Button1Click(Sender: TObject);
 60 
    procedure Button1Click(Sender: TObject);
59 
    procedure Button3Click(Sender: TObject);
 61 
    procedure Button3Click(Sender: TObject);
60 
    procedure Button4Click(Sender: TObject);
 62 
    procedure Button4Click(Sender: TObject);
61 
    procedure Button7Click(Sender: TObject);
 63 
    procedure Button7Click(Sender: TObject);
Line 744... Line 746...
744 
    else if not onlyfirst then
 746 
    else if not onlyfirst then
745 
      result := result + ',' + ListBox1.Items.Strings[i];
 747 
      result := result + ',' + ListBox1.Items.Strings[i];
746 
  end;
 748 
  end;
747 
end;
 749 
end;
748 
 
 750 
 
749 
function DirectoryExists(const Directory: string; FollowLink: Boolean): Boolean; { Source: Delphi 10.3.3 }
 - 
 
750 
{
 - 
 
751 
var
 - 
 
752 
  Code: Cardinal;
 - 
 
753 
  Handle: THandle;
 - 
 
754 
  LastError: Cardinal;
 - 
 
755 
const
 - 
 
756 
  faSymLink = $00000400; // Available on POSIX and Vista and above
 - 
 
757 
  INVALID_FILE_ATTRIBUTES = DWORD($FFFFFFFF);
 - 
 
758 
begin
 - 
 
759 
  Result := False;
 - 
 
760 
  Code := GetFileAttributes(PChar(Directory));
 - 
 
761 
 
 - 
 
762 
  if Code <> INVALID_FILE_ATTRIBUTES then
 - 
 
763 
  begin
 - 
 
764 
    if faSymLink and Code = 0 then
 - 
 
765 
      Result := faDirectory and Code <> 0
 - 
 
766 
    else
 - 
 
767 
    begin
 - 
 
768 
      if FollowLink then
 - 
 
769 
      begin
 - 
 
770 
        Handle := CreateFile(PChar(Directory), GENERIC_READ, FILE_SHARE_READ, nil,
 - 
 
771 
          OPEN_EXISTING, FILE_FLAG_BACKUP_SEMANTICS, 0);
 - 
 
772 
        if Handle <> INVALID_HANDLE_VALUE then
 - 
 
773 
        begin
 - 
 
774 
          CloseHandle(Handle);
 - 
 
775 
          Result := faDirectory and Code <> 0;
 - 
 
776 
        end;
 - 
 
777 
      end
 - 
 
778 
      else if faDirectory and Code <> 0 then
 - 
 
779 
        Result := True
 - 
 
780 
      else
 - 
 
781 
      begin
 - 
 
782 
        Handle := CreateFile(PChar(Directory), GENERIC_READ, FILE_SHARE_READ, nil,
 - 
 
783 
          OPEN_EXISTING, FILE_FLAG_BACKUP_SEMANTICS, 0);
 - 
 
784 
        if Handle <> INVALID_HANDLE_VALUE then
 - 
 
785 
        begin
 - 
 
786 
          CloseHandle(Handle);
 - 
 
787 
          Result := False;
 - 
 
788 
        end
 - 
 
789 
        else
 - 
 
790 
          Result := True;
 - 
 
791 
      end;
 - 
 
792 
    end;
 - 
 
793 
  end
 - 
 
794 
  else
 - 
 
795 
  begin
 - 
 
796 
    LastError := GetLastError;
 - 
 
797 
    Result := (LastError <> ERROR_FILE_NOT_FOUND) and
 - 
 
798 
      (LastError <> ERROR_PATH_NOT_FOUND) and
 - 
 
799 
      (LastError <> ERROR_BAD_PATHNAME) and
 - 
 
800 
      (LastError <> ERROR_INVALID_NAME) and
 - 
 
801 
      (LastError <> ERROR_BAD_NETPATH) and
 - 
 
802 
      (LastError <> ERROR_NOT_READY) and
 - 
 
803 
      (LastError <> ERROR_BAD_NET_NAME);
 - 
 
804 
  end;
 - 
 
805 
}
 - 
 
806 
begin
 - 
 
807 
  { TODO }
 - 
 
808 
end;
 - 
 
809 
 
 - 
 
810 
function IniValueExists(ini: TIniFile; const Section, Ident: string): Boolean;
 751 
function IniValueExists(ini: TIniFile; const Section, Ident: string): Boolean;
811 
var
 752 
var
812 
  S: TStrings;
 753 
  S: TStrings;
813 
begin
 754 
begin
814 
  S := TStringList.Create;
 755 
  S := TStringList.Create;
Line 818... Line 759...
818 
  finally
 759 
  finally
819 
    S.Free;
 760 
    S.Free;
820 
  end;
 761 
  end;
821 
end;
 762 
end;
822 
 
 763 
 
- 
 
 764 
var
- 
 
 765 
  MkDirTriedOnce: boolean; { Avoid that the debugger always shows the exception }
- 
 
 766 
procedure MakeDirIfRequired(dirname: string);
- 
 
 767 
begin
- 
 
 768 
  if dirname[Length(dirname)] = '\' then dirname := Copy(dirname, 1, Length(dirname)-1);
- 
 
 769 
 
- 
 
 770 
  if not MkDirTriedOnce then
- 
 
 771 
  begin
- 
 
 772 
    try
- 
 
 773 
      MkDir(dirname);
- 
 
 774 
    except
- 
 
 775 
    end;
- 
 
 776 
    MkDirTriedOnce := true;
- 
 
 777 
  end;
- 
 
 778 
end;
- 
 
 779 
 
823 
function TForm1.DBPath: string;
 780 
function TForm1.DBPath: string;
824 
var
 781 
var
825 
  ini: TIniFile;
 782 
  ini: TIniFile;
826 
begin
 783 
begin
827 
  ini := TIniFile.Create('.\OIDPLUS.INI');
 784 
  ini := TIniFile.Create('.\OIDPLUS.INI');
Line 834... Line 791...
834 
    end
 791 
    end
835 
    else
 792 
    else
836 
    begin
 793 
    begin
837 
      result := ini.ReadString('SETTINGS', 'DATA', 'DB\');
 794 
      result := ini.ReadString('SETTINGS', 'DATA', 'DB\');
838 
    end;
 795 
    end;
839 
    if not DirectoryExists(result, true) then MkDir(result);
 - 
 
840 
    if not DirectoryExists(result, true) then
 796 
    MakeDirIfRequired(result);
841 
    begin
 - 
 
842 
      ShowError('Cannot create database directory '+result);
 - 
 
843 
    end;
 - 
 
844 
  finally
 797 
  finally
845 
    ini.Free;
 798 
    ini.Free;
846 
  end;
 799 
  end;
847 
end;
 800 
end;
848 
 
 801 
 
Line 925... Line 878...
925 
  end;
 878 
  end;
926 
  if Key = #8(*backspace*) then exit;
 879 
  if Key = #8(*backspace*) then exit;
927 
  if Key in ['a'..'z'] then Key := UpCase(Key);
 880 
  if Key in ['a'..'z'] then Key := UpCase(Key);
928 
  if not (Key in ['A'..'Z', '-']) then
 881 
  if not (Key in ['A'..'Z', '-']) then
929 
  begin
 882 
  begin
930 
    { Beep; TODO }
 883 
    MessageBeep(0);
931 
    Key := #0;
 884 
    Key := #0;
932 
  end;
 885 
  end;
933 
end;
 886 
end;
934 
 
 887 
 
935 
procedure TForm1.Edit11Change(Sender: TObject);
 888 
procedure TForm1.Edit11Change(Sender: TObject);
Line 987... Line 940...
987 
    begin
 940 
    begin
988 
      Button8.Click;
 941 
      Button8.Click;
989 
    end
 942 
    end
990 
    else
 943 
    else
991 
    begin
 944 
    begin
992 
      { Beep; TODO }
 945 
      MessageBeep(0);
993 
    end;
 946 
    end;
994 
 
 947 
 
995 
    Key := 0;
 948 
    Key := 0;
996 
  end;
 949 
  end;
997 
end;
 950 
end;