So I am creating a pascal script that will create a directory within a main directory and ALSO create multiple folders inside of that new directory. (Insert XZibit pun)
Now the way we do this where I work, we send these variables to an exe that will then create directories based on what is being passed (in this case, path 'fullpath').
I am not sure if I am approaching this correctly and would love the much more prominent PASCAL guru's input :)
const
ARRAY1: Array[1..9] of String = (
'NQN', 'Documents', 'Correspondences',
'Worksheets', 'Reports', 'Claims',
'Certificate of Insurance', 'Invoice', 'Monthly Reports'
);
var
i: Integer;
fullpath, path, name, os, es, cmd: String;
Code : LongWord;
res: Integer;
Begin
path := 'Policies'
fullpath := path+'\'+[i]
for i := 1 to 9 do
IF(ReqList.Values['sRM_ID'] = '') then
Begin
cmd := 'C:\XXX\bin\mkdir.exe "'+fullpath+'"';
res :=ExecuteProc(cmd, 'C:\XXX\bin', true, -1, true, nil, os, es, code);
if(res = 0) then
Begin
ReqList.values['NoErrors'] := '1';
ReqList.Values['Response_content']:= '{"valid":"1","message":"'+ReplaceString(ReplaceString(os,#13,'',false),#10,'',false)+'"}';
end
else
begin
ReqList.Values['NoErrors'] := '0';
Reqlist.Values['Response_Content'] := '{"valid":"0","message":"'+ReplaceString(ReplaceString(os,#13,'',false),#10,'',false)+'"}';
end;
END
ELSE
Begin
ReqList.Values['Response_Content'] := '{"valid":"0","message":"A folder or file with the same name already exists."}';
End;
ReqList.Values['Response_ContentType'] := 'HTML';
Once you identify the absolute path for each entry in your array, ForceDirectories will create them if they don't already exist, as bummi suggested above.
Assuming your root path is relative to the current executable path, it could be as simple as this:
const
ARRAY1: Array [1 .. 9] of String = ('NQN', 'Documents', 'Correspondences',
'Worksheets', 'Reports', 'Claims', 'Certificate of Insurance', 'Invoice',
'Monthly Reports');
var
s: string;
path: string;
fullpath: string;
begin
path := 'Policies';
for s in ARRAY1 do
begin
fullpath := ExpandFileName(IncludeTrailingPathDelimiter(path) + s);
ForceDirectories(fullpath);
end;
end;
Related
How to make the user select an item from a combobox and then write it to an INI file as a number (01, 02, 03, ..., 18)? I generated this code but I do not know what else to do. If you could help me I would be very grateful
[INI]
Filename: "{app}\rev.ini"; Section: "steamclient"; Key: "RankLevel"; String: ""
[Code]
var
NewComboBox1: TNewComboBox;
procedure RedesignWizardForm;
begin
{ NewComboBox1 }
NewComboBox1 := TNewComboBox.Create(WizardForm);
with NewComboBox1 do
begin
Name := 'NewComboBox1';
Parent := WizardForm.SelectDirPage;
Left := ScaleX(0);
Top := ScaleY(120);
Width := ScaleX(145);
Height := ScaleY(21);
Text := 'Alcon';
Items.Text := 'Alcon' + #13#10 +
'Aguila' + #13#10 +
'Elite' + #13#10 +
'Pro';
ItemIndex := 0;
end;
NewComboBox1.TabOrder := 5;
end;
procedure InitializeWizard();
begin
RedesignWizardForm;
end;
The easiest solution is using a scripted constant in the INI section:
[INI]
Filename: "{app}\rev.ini"; Section: "steamclient"; \
Key: "RankLevel"; String: "{code:GetRankLevel}"
[Code]
{ ... }
function GetRankLevel(Param: string): string;
begin
Result := Format('%.2d', [NewComboBox1.ItemIndex + 1]);
end;
Though this will not write the INI file "in a custom page after the components section". It will write it only during the actual installation, what is the correct behavior, imho.
See also Save Inno Setup custom page field values to an INI file.
I have demo.properties file from this I'm able to load file and iterate to get all values present in it.
hibernate.connection.username=jack
hibernate.connection.password=queen
hibernate.connection.url=jdbc:jtds:sqlserver://localhost/cabinet
But when I get Line 1 (able to get line by line but unable to get specific string) and i want to populate jack and store into username String similarly queen into password String and localhost into database String.This is my code/logic to get values.
procedure InitializeWizard;
var
xmlInhalt: TArrayOfString;
k : Integer;
CurrentLine : String;
Uname : String;
Password : String;
HostName : String;
STR : String;
begin
LoadStringsFromFile('C:\demo.properties', xmlInhalt);
for k:=0 to GetArrayLength(xmlInhalt)<>-1 do
begin
CurrentLine := xmlInhalt[k];
MsgBox(CurrentLine, mbError, MB_OK);
if (Pos('hibernate.connection.username=', CurrentLine) <>-1 ) then
begin
MsgBox(CurrentLine, mbError, MB_OK);
Uname := Pos('://', CurrentLine);
STR :=IntToStr(Uname);
STR :=IntToStr(Length('://'));
Password := Pos(':1', CurrentLine);
HostName :=Password -Uname;
end;
end;
end;
please Help me to get my requirement.Your help will be appreciated.
If the TStrings class had published NameValueSeparator and Values properties, I would suggest using it. But it hasn't, so here's a code to workaround (it uses TArrayOfString, but it would be easy to modify it for the TStrings class):
[Setup]
AppName=My Program
AppVersion=1.5
DefaultDirName={pf}\My Program
[Code]
function TryGetValue(const Strings: TArrayOfString; const Name: string;
out Value: string): Boolean;
var
S: string;
P: Integer;
I: Integer;
begin
Result := False;
{ loop through the array }
for I := 0 to GetArrayLength(Strings) - 1 do
begin
{ store the currently iterated string into a local variable }
S := Strings[I];
{ try to get position of the name value separator ('='in this case) }
P := Pos('=', S);
{ if the separator was found on this line, and a text on the left of }
{ it matches (case insensitively) the input Name parameter value, we }
{ found what we were looking for, so return True and the rest of the }
{ text after the found separator }
if (P <> 0) and (CompareText(Copy(S, 1, P - 1), Name) = 0) then
begin
Value := Copy(S, P + 1, MaxInt);
Result := True;
Exit;
end;
end;
end;
{ do note, that this function may not conform the RFC 3986 specification; }
{ preferred way should be e.g. InternetCrackUrl, but with this particular }
{ scheme (jdbc:jtds:sqlserver) it didn't crack the URL properly }
function GetHostName(const URL: string): string;
var
P: Integer;
begin
Result := '';
P := Pos('://', URL);
if P <> 0 then
begin
Result := Copy(URL, P + 3, MaxInt);
P := Pos('/', Result);
if P = 0 then
P := MaxInt;
Result := Copy(Result, 1, P - 1);
end;
end;
procedure InitializeWizard;
var
URL: string;
HostName: string;
UserName: string;
Password: string;
StrArray: TArrayOfString;
begin
if LoadStringsFromFile('C:\File.txt', StrArray) then
begin
TryGetValue(StrArray, 'hibernate.connection.url', URL);
HostName := GetHostName(URL);
TryGetValue(StrArray, 'hibernate.connection.username', UserName);
TryGetValue(StrArray, 'hibernate.connection.password', Password);
MsgBox(Format(
'HostName: %s' + #13#10 + 'UserName: %s' + #13#10 + 'Password: %s', [
HostName, UserName, Password]
), mbInformation, MB_OK);
end;
end;
Using Delphi 7, I need to move all the content (files, folders and subfolders) from one folder to another one. After some research, SHFileOpStruct seems to be the best option. Here is what I got so far:
function MoveDir(SrcDir, DstDir: string): Boolean;
var
FOS: TSHFileOpStruct;
begin
ZeroMemory(#FOS, SizeOf(FOS));
with FOS do
begin
wFunc := FO_MOVE; // FO_COPY;
fFlags := FOF_FILESONLY or
FOF_ALLOWUNDO or FOF_SIMPLEPROGRESS;
pFrom := PChar(SrcDir + #0);
pTo := PChar(DstDir + #0);
end;
Result := (SHFileOperation(FOS) = 0);
end;
But when using this function, the entire folder is moved to destination, not only it content. For example, if I use MoveDir('c:\test', 'd:\test') I get d:\teste\teste.
I already tried to change this line bellow, and it works when coping the files (FO_COPY) but not when moving.
pFrom := PChar(SrcDir + '\*.*' + #0);
Please, can someone help me with this? Would be great if I can do this without moving file by file, folder by folder...
Thanks!!
You should use your second version, without FOF_FILESONLY flag:
function MoveDir(SrcDir, DstDir: string): Boolean;
var
FOS: TSHFileOpStruct;
begin
ZeroMemory(#FOS, SizeOf(FOS));
with FOS do
begin
wFunc := FO_MOVE; // FO_COPY;
fFlags := FOF_ALLOWUNDO or FOF_SIMPLEPROGRESS;
pFrom := PChar(IncludeTrailingPathDelimiter(SrcDir) + '*.*'#0);
pTo := PChar(DstDir + #0);
end;
Result := (SHFileOperation(FOS) = 0);
end;
In my code I have the following type and array
I get a string that I would like to check if it exist in the array and from its index I need to get a value from TProgramModule
Example: I have the text Job and needs to find that it has the index 3 in array ModuleName then I need to check TProgramModule and get modJobsystem as it is item 3
Hope that explains what I am looking for - any other ways to get the result is also welcome
type
TProgramModule = (
modBlank,
modMeter,
modFinance,
modJobsystem,
modTimesheet,
modTaskmanagement,
modHomeContents,
modDiary,
modCases,
modDocuments,
modContacts
);
const
ModuleName: array[TProgramModule] of string = (
'Blank',
'Måleraflæsning',
'Konti',
'Job',
'Timesedler',
'Opgaver',
'Indbo',
'Dagbog',
'Sagsstyring',
'Dokumentstyring',
'Kontaktpersoner'
);
This can be done pretty simply with a loop:
var
i: Integer;
Find: string;
Module: TProgramModule;
begin
Find := 'Job';
for i := Low(ModuleName) to High(ModuleName) do
if ModuleName[i] = Find then
begin
Module := i;
Break;
end;
end;
You should probably turn this into a function that accepts the value to search for as a string and returns the proper TProgramModule. The question at that point becomes what the function should return if the string isn't found in ModuleName.
function FindProgramModule(const Name: string): TProgramModule;
var
i: TProgramModule;
begin
for I := Low(ModuleName) to High(ModuleName) do
if ModuleName[i] = Name then
Exit(i);
Exit(modBlank); // Not found - return whatever default value here
end;
For older versions of Delphi that don't support Exit():
function FindProgramModule(const Name: string): TProgramModule;
var
i: TProgramModule;
begin
Result := modBlank; // Whatever default value goes here
for I := Low(ModuleName) to High(ModuleName) do
if ModuleName[i] = Name then
begin
Result := i;
Break;
end;
end;
I'd write it like this:
function FindProgramModule(const Name: string): TProgramModule;
begin
for Result := Low(ModuleName) to High(ModuleName) do
if ModuleName[Result] = Name then
Exit;
Raise EModuleNotFound.CreateFmt(
'Module not recognised: %s',
[Name]
);
end;
If you don't want to raise an exception then return a sentinel enum to indicate that the module was not recognised.
what would be a neat way to create multiple *.txt files on application
startup i.e check if they exist if not create them.
I need to create about 10 text files.
Will I have to do like this for every single file:
var
MyFile: textfile;
ApplicationPath: string;
begin
ApplicationPath := ExtractFileDir(Application.ExeName);
if not FileExists(ApplicationPath + '\a1.txt') then
begin
AssignFile(MyFile, (ApplicationPath + '\a1.txt'));
Rewrite(MyFile);
Close(MyFile);
end
else
Abort;
end;
If you only want to create the empty files (or rewrite the existing) with subsequently numbered file names, you might try something like this. The following examples use the CreateFile API function. But pay attention that several things may forbid your file creation attempts!
If you want to create (overwrite) them in all circumstances, use CREATE_ALWAYS disposition flag
procedure TForm1.Button1Click(Sender: TObject);
var
I: Integer;
Name: string;
Path: string;
begin
Path := ExtractFilePath(ParamStr(0));
for I := 1 to 10 do
begin
Name := Path + 'a' + IntToStr(I) + '.txt';
CloseHandle(CreateFile(PChar(Name), 0, 0, nil, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0));
end;
end;
Or if you want to create the files only if they doesn't exist, use the CREATE_NEW disposition flag
procedure TForm1.Button1Click(Sender: TObject);
var
I: Integer;
Name: string;
Path: string;
begin
Path := ExtractFilePath(ParamStr(0));
for I := 1 to 10 do
begin
Name := Path + 'a' + IntToStr(I) + '.txt';
CloseHandle(CreateFile(PChar(Name), 0, 0, nil, CREATE_NEW, FILE_ATTRIBUTE_NORMAL, 0));
end;
end;
Something like this, perhaps:
var
ApplicationDir: string;
I: Integer;
F: TextFile;
begin
ApplicationDir := ExtractFileDir(Application.ExeName);
for I := 1 to 10 do
begin
Path := ApplicationDir + '\a' + IntToStr(I) + '.txt';
if not FileExists(Path) then
begin
AssignFile(F, Path);
Rewrite(F);
Close(F);
end
end;
procedure CreateFile(Directory: string; FileName: string; Text: string);
var
F: TextFile;
begin
try
AssignFile(F, Directory + '\' + FileName);
{$i-}
Rewrite(F);
{$i+}
if IOResult = 0 then
begin
Writeln(F, Text);
end;
finally
CloseFile(f);
end;
end;
...
for i := 0 to 10 do
CreateFile(Directory, Filename, Text);