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; |