For some reason, using
SearchText := 'Program Files';
ReplaceText := 'Program Files (x86)';
SearchAndReplace(SearchText, ReplaceText);
Would do absolutely nothing, it just won't change text, works fine when using any other text.
Is this some sort of "Reserve" word? Or ( ) is what makes it do not work?
procedure Tfc_Great.SearchAndReplace
(InSearch, InReplace: string) ;
var X, ToEnd : integer;
oldCursor : TCursor;
begin
oldCursor := Screen.Cursor;
Screen.Cursor := crHourglass;
with RichEdit1 do
begin
X := 0;
ToEnd := length(Text) ;
X := FindText(inSearch, X, ToEnd, []) ;
while X <> -1 do
begin
SetFocus;
SelStart := X;
SelLength := length(inSearch) ;
SelText := InReplace;
X := FindText(inSearch,
X + length(InReplace),
ToEnd, []) ;
end;
end;
Screen.Cursor := oldCursor;
end;
Try to assign the output ;)
SearchText := 'Program Files';
ReplaceText := 'Program Files (x86)';
ResultText := SearchAndReplace(Text, SearchText, ReplaceText);
with
function SearchAndReplace
(sSrc, sLookFor, sReplaceWith : string) : string;
var
nPos, nLenLookFor : integer;
begin
nPos := Pos(sLookFor, sSrc) ;
nLenLookFor := Length(sLookFor) ;
while (nPos > 0) do begin
Delete(sSrc, nPos, nLenLookFor) ;
Insert(sReplaceWith, sSrc, nPos) ;
nPos := Pos(sLookFor, sSrc) ;
end;
Result := sSrc;
end;
Related
I created a procedure to update an SQLite DB. The procedure runs in a loop until the list is finished. The problem is, when I run the procedure, the program stops responding
How can I run this procedure in the background, without crashing the program?
procedure TForm1.domainupdate;
var
I, J, K, svr: integer ;
domain1, domain2: string ;
expiry: string;
sl: TStringList;
fs: TFormatSettings;
s: string;
dt: TDatetime;
ds : TFormatSettings;
memo : tmemo;
begin
DM.Qdomains.First;
while not DM.Qdomains.Eof do begin
for J := Length (DM.Qdomains.FieldByName('domain').AsString) downto 2 do begin
if DM.Qdomains.FieldByName('domain').AsString [J] = '.' then begin // search host.co.uk
if domain1 = '' then
domain1 := Copy (DM.Qdomains.FieldByName('domain').AsString, J + 1, 99) + IcsSpace
// found uk
else begin
domain2 := Copy (DM.Qdomains.FieldByName('domain').AsString, J + 1, 99) + IcsSpace ;
// found co.uk
Break ;
end;
end;
end;
FWhoisServers := TStringList.Create;
for I := 0 to Length(WhoisNames) - 1 do
FWhoisServers.add(WhoisNames[I]);
FHost := 'whois.ripe.net' ;
K := -1 ;
if FWhoisServers.Count > 0 then begin
for I := 0 to FWhoisServers.Count - 1 do
begin
if (Pos (domain1, FWhoisServers [I]) = 1) then K := I ;
if (Pos (domain2, FWhoisServers [I]) = 1) then
begin
K := I ;
break ;
end ;
end;
if K >= 0 then begin
J := Pos (IcsSpace, FWhoisServers [K]) ;
end;
end;
if K < 0 then begin
end;
IdWhois1.host := Copy (FWhoisServers [K], J + 1, 99) ;
Memo:=TMemo.Create(nil);
Memo.Visible:=false;
memo.Lines.text := IdWhois1.WhoIs(DM.Qdomains.FieldByName('domain').AsString);
begin
sl := TStringList.Create;
try
sl.Assign(Memo.Lines);
for I := 0 to sl.Count-1 do begin
sl[I] := TrimLeft(sl[I]);
end;
sl.NameValueSeparator := ':';
for I := Low(FieldNames) to High(FieldNames) do begin
expiry := Trim(sl.Values[FieldNames[I]]);
if expiry <> '' then
Break;
end;
finally
sl.Free;
end;
if expiry = '' then
exit
else
s := expiry;
fs := TFormatSettings.Create;
fs.DateSeparator := '-';
fs.TimeSeparator := ':';
fs.shortdateformat := 'yyyy-mm-dd';
fs.ShortTimeFormat := 'hh:nn:ss';
dt := StrToDatetime(s, fs);
ds.DateSeparator := '/';
ds.TimeSeparator := ':';
ds.ShortDateFormat := 'dd/mm/yyyy';
ds.longtimeFormat := 'hh:mm:ss';
end;
end;
//********************************************************
//********************************************************
//if edit1.text <> '' then DM.Qdomains.Open;
DM.Qdomains.Edit;
DM.Qdomains.FieldByName('domain').AsString :=
DM.Qdomains.FieldByName('domain').AsString;
DM.Qdomains.FieldByName('expiry').AsString := datetimetostr(dt, ds);
DM.Qdomains.FieldByName('whois').AsString :=
IdWhois1.WhoIs(DM.Qdomains.FieldByName('domain').AsString);
DM.Qdomains.FieldByName('update').AsString := DatetimeToStr(now);
DM.Qdomains.Post;
DM.Qdomains.Next;
end;
Move the logic into a separate worker thread, synchronizing with the main UI thread only when absolutely needed (ie, to show the results). You need to do this anyway if you ever plan on running this code on Android, since you can't perform network operations on the main UI thread.
Also, get rid of the TMemo that the code is creating, it is not needed at all. All you are using it for is to parse the Whois result into a TStringList, which you can do directly. And, you are leaking the TMemo and never showing it to the user anyway.
Try something more like this:
procedure TForm1.DomainUpdate;
var
I, J, K: Integer;
domain, domain1, domain2, host, whois, expiry: string;
sl: TStringList;
fs, ds: TFormatSettings;
dt: TDatetime;
begin
// TODO: perform the DB query here instead of in the main thread...
DM.Qdomains.First;
while not DM.Qdomains.Eof do begin
domain := DM.Qdomains.FieldByName('domain').AsString;
domain1 := '';
domain2 := '';
for J := Length(domain) downto 2 do begin
if domain[J] = '.' then begin // search host.co.uk
if domain1 = '' then
domain1 := Copy(domain, J + 1, MaxInt) + IcsSpace
// found uk
else begin
domain2 := Copy(domain, J + 1, MaxInt) + IcsSpace;
// found co.uk
Break;
end;
end;
end;
FWhoisServers := TStringList.Create;
try
for I := 0 to Length(WhoisNames) - 1 do
FWhoisServers.Add(WhoisNames[I]);
host := 'whois.ripe.net';
K := -1;
if FWhoisServers.Count > 0 then begin
for I := 0 to FWhoisServers.Count - 1 do
begin
if (Pos(domain1, FWhoisServers[I]) = 1) then K := I;
if (Pos(domain2, FWhoisServers[I]) = 1) then
begin
K := I;
Break;
end;
end;
if K >= 0 then begin
J := Pos(IcsSpace, FWhoisServers[K]);
host := Copy(FWhoisServers[K], J + 1, MaxInt);
end;
end;
IdWhois1.Host := host;
finally
FWhoisServers.Free;
end;
expiry := '';
sl := TStringList.Create;
try
whois := IdWhois1.WhoIs(domain);
sl.Text := whois;
for I := 0 to sl.Count-1 do begin
sl[I] := TrimLeft(sl[I]);
end;
sl.NameValueSeparator := ':';
for I := Low(FieldNames) to High(FieldNames) do begin
expiry := Trim(sl.Values[FieldNames[I]]);
if expiry <> '' then
Break;
end;
finally
sl.Free;
end;
if expiry <> '' then begin
fs := TFormatSettings.Create;
fs.DateSeparator := '-';
fs.TimeSeparator := ':';
fs.ShortDateFormat := 'yyyy-mm-dd';
fs.ShortTimeFormat := 'hh:nn:ss';
dt := StrToDateTime(expiry, fs);
ds := TFormatSettings.Create;
ds.DateSeparator := '/';
ds.TimeSeparator := ':';
ds.ShortDateFormat := 'dd/mm/yyyy';
ds.LongTimeFormat := 'hh:mm:ss';
DM.Qdomains.Edit;
try
DM.Qdomains.FieldByName('domain').AsString := domain;
DM.Qdomains.FieldByName('expiry').AsString := DateTimeToStr(dt, ds);
DM.Qdomains.FieldByName('whois').AsString := whois;
DM.Qdomains.FieldByName('update').AsString := DateTimeToStr(Now);
DM.Qdomains.Post;
except
DM.Qdomains.Cancel;
raise;
end;
end;
DM.Qdomains.Next;
end;
end;
...
TThread.CreateAnonymousThread(DomainUpdate).Start;
Printing using Epson codes in Delphi Tokyo.
Function PrintRawData (built in to Winapi.Winspool library) appears to misread codes like 'ESC C' or 'ESC #' and prints 'C' and '#' instead of the prompts associated with said codes (Select page length & Initialise Printer).
procedure TFrmPrint.PageLen(hPrn : THandle); // Page length in Inches
var
Commalist : Array[1..20] of SmallInt;
istart, icomma, i : SmallInt;
ss, cr : UTF8String;
def : UTF8String;
Data : Array [0..255] of AnsiChar;
begin
ss := '';
cr := ' ';
cr[1] := #13; cr[2] := #10;
if not DM2.Q_PRNGen.Locate('PrAction','PAGELENIN',[loCaseInsensitive]) then
begin
ShowMessage('PAGELENIN Action not coded for Printer');
exit;
end;
ss := Trim(DM2.Q_PRNGen.Fields.FieldByName('ESCCODE').AsString);
icomma := 0;
istart := 1;
for i:=1 to Length(ss) do
begin
if ss[i] = ',' then
begin
inc(icomma);
Commalist[icomma] := StrToIntDef(Copy(ss,istart,i-istart),0);
istart := i + 1;
end;
end;
inc(icomma);
i := Length(ss);
Commalist[icomma] := StrToIntDef(Copy(ss,istart,i-istart+1),0);
def := '';
for i:=1 to icomma do
begin
def := def + ' ';
def[i] := AnsiChar(CommaList[i]);
// def := Def + IntToHex(CommaList[i],1);
end;
// ss := def + cr;
ss := def;
for i:=1 to Length(ss) do Data[i-1] := AnsiChar(ss[i]);
if frmPrint.PrintRawData(hPrn,#Data,Length(ss)) < 0 then
begin
ShowMessage('PrintRawData Failed');
frmPrint.EndRawPrintPage(hPrn);
frmPrint.EndRawPrintJob(hPrn);
exit;
end;
end;
It is under my assumption that the error lies within PrintRawData.
PrintRawData is listed here:
function TFrmPrint.PrintRawData(hPrn : THandle; Buffer : pointer; NumBytes : SpoolInt) : integer;
var
BytesWritten : DWORD;
begin
if NumBytes = 0 then
begin
Result := 1;
exit;
end;
if not WritePrinter(hPrn, Buffer, NumBytes, BytesWritten) then
begin
Result := -1;
exit;
end;
if NumBytes <> BytesWritten then
begin
Result := -1;
exit;
end;
Result := 1;
end;
Anyone can help how can I transfrom this to work with TcxCheckGroup? My procedure can be load checked Items states to cxCheckListBox.
Working example with TcxCheckListBox...
procedure Tfrm.LoadStatesFromStream(SS: TStringStream);
var
i : integer;
S2 : String;
begin
SS.Position := 0;
i := 0;
while (i <= cxCheckListBox1.Items.Count - 1) and (SS.Position < SS.Size) do
begin
S2 := SS.ReadString(1);
cxCheckListBox1.Items[i].Checked := S2 = '+';
Inc(i);
end;
end;
I need a help with...
procedure Tfrm.LoadStatesFromStream(SS: TStringStream);
var
i : integer;
S2 : String;
begin
SS.Position := 0;
i := 0;
while (i <= cxCheckGroup1.Properties.Items.Count - 1) and (SS.Position < SS.Size) do
begin
S2 := SS.ReadString(1);
(cxCheckGroup1.States[i] = cbschecked ):= S2 = '+'; //I have a problem here
Inc(i);
end;
end;
Thanks for the help!
See the code below; I assumed that you want to include the possibility that a checkbox's state might be cbsGrayed (which I've represented by a space character in the StringStream.
function CheckBoxStateToString(CheckBoxState : TcxCheckBoxState ) : String;
begin
Result := '';
case CheckBoxState of
cbsChecked : Result := '+';
cbsUnChecked : Result := '-';
cbsGrayed : Result := ' ';
end;
end;
function StringToCheckBoxState(Input : String) : TcxCheckBoxState;
begin
Result := cbsGrayed;
if Input = '+' then
Result := cbsChecked
else
if Input = '-' then
Result := cbsUnChecked
end;
procedure TForm1.SaveCheckGroupStatesToStream(SS : TStringStream);
var
i : integer;
begin
SS.Clear;
SS.Position := 0;
for i := 0 to cxCheckGroup1.Properties.Items.Count - 1 do begin
SS.WriteString(CheckBoxStateToString(cxCheckGroup1.States[i]));
end;
Memo1.Lines.Add('>' + SS.DataString + '<');
end;
procedure TForm1.LoadCheckGroupStatesFromStream(SS : TStringStream);
var
i : integer;
S : String;
begin
CheckBoxList.ClearCheckmarks;
SS.Position := 0;
i := 0;
while (i <= cxCheckGroup1.Properties.Items.Count - 1) and (SS.Position < SS.Size) do begin
S := SS.ReadString(1);
cxCheckGroup1.States[i] := StringToCheckBoxState(S);
Inc(i);
end;
end;
I want to dump a complex / long record into a memo for debugging purpose
TmyRecord =
aValue : String
aNumber : Real;
Morenumbers : Integer ;
....
....
end;
I think Delphi XE 2 RTTI should give me the chance to get the Fieldname , Fieldtype and value
within a loop, to write this record to a memo or .....
As starting point - record with simple types. For complex fields (array, class etc) explore RTTI unit
type
TmyRecord = record
aValue: String;
aNumber: Real;
Morenumbers: Integer;
end;
var
m: TMyRecord;
rtype: TRTTIType;
fields: TArray<TRttiField>;
i: Integer;
begin
m.aValue := 'OK';
m.aNumber := Pi;
m.Morenumbers := 666;
rtype := TRTTIContext.Create.GetType(TypeInfo(TMyrecord));
Memo1.Lines.Add(rtype.ToString);
fields := rtype.GetFields;
for i := 0 to High(fields) do
Memo1.Lines.Add(Format('%s: %s :: %s', [
fields[i].Name,
fields[i].FieldType.ToString,
fields[i].GetValue(#m).ToString]));
output:
TmyRecord
aValue: string :: OK
aNumber: Real :: 3.14159265358979
Morenumbers: Integer :: 666
Here is my try at this. I have similar task as you (refer to this thread). It's work in progress, but does the job good enough so far. This would enumerate all properties inside the TObject thou, so you'll have to adapt it to enumerate records:
function EnumerateProperties(const AObject: TObject): String;
var
rt: TRttiType;
prop: TRttiProperty;
value, value2: TValue;
valstr: String;
propstr: String;
fullstr: String;
bres: Boolean;
meth: TRttiMethod;
bytes: TBytes;
bytes_arr: TArray<TBytes>;
uints: TArray<UINT32>;
C1: Integer;
begin
if not Assigned(AObject) then
Exit('');
rt := TRttiContext.Create.GetType(AObject.ClassType);
fullstr := '';
// iterate through public properties
for prop in rt.GetDeclaredProperties do
begin
value := prop.GetValue(AObject); // get property value
valstr := '?';
// check property type
case prop.PropertyType.TypeKind of
tkInteger,
tkInt64,
tkFloat: valstr := value.AsVariant;
tkString,
tkChar,
tkWChar,
tkLString,
tkWString,
tkUString: valstr := QuotedStr(value.AsString);
tkEnumeration: begin
valstr := 'ENUM';
if value.TryAsType<Boolean>(bres) then
valstr := BoolToStr(bres, TRUE)
else
begin
valstr := GetEnumName(value.TypeInfo, prop.GetValue(AObject).AsOrdinal);
end;
end;
tkClass: begin
// check if property is TList or any of its descendants,
// then iterate through each of it's members
meth := prop.PropertyType.GetMethod('ToArray');
if Assigned(meth) then
begin
value2 := meth.Invoke(value, []);
Assert(value2.IsArray);
for C1 := 0 to value2.GetArrayLength - 1 do
valstr := valstr + Format('(%s), ', [EnumerateProperties(value2.GetArrayElement(C1).AsObject)]);
if valstr <> '' then
Delete(valstr, Length(valstr) - 1, 2);
valstr := Format('[%s]', [valstr]);
end
else // otherwise, process it as normal class
valstr := Format('[%s]', [EnumerateProperties(value.AsObject)]);
end;
// dynamic arrays
tkDynArray: begin
if value.TryAsType<TBytes>(bytes) then // TBytes
valstr := BytesToHex(bytes)
else
if value.TryAsType<TArray<TBytes>>(bytes_arr) then // TArray<TBytes>
begin
valstr := '';
for C1 := Low(bytes_arr) to High(bytes_arr) do
valstr := valstr + QuotedStr(BytesToHex(bytes_arr[C1])) + ', ';
if valstr <> '' then
Delete(valstr, Length(valstr) - 1, 2);
valstr := Format('(%s)', [valstr]);
end
else
if value.TryAsType<TArray<UINT32>>(uints) then // TArray<UINT32>
begin
valstr := '';
for C1 := Low(uints) to High(uints) do
valstr := valstr + IntToStr(uints[C1]) + ', ';
if valstr <> '' then
Delete(valstr, Length(valstr) - 1, 2);
valstr := Format('(%s)', [valstr]);
end;
end;
tkUnknown: ;
tkSet: ;
tkMethod: ;
tkVariant: ;
tkArray: ;
tkRecord: ;
tkInterface: ;
tkClassRef: ;
tkPointer: ;
tkProcedure: ;
end;
propstr := Format('%s: %s', [prop.Name, valstr]);
fullstr := fullstr + propstr + '; ';
end;
if fullstr <> '' then
Delete(fullstr, Length(fullstr) - 1, 2);
result := fullstr;
end;
I would like to know how I can get all the driver files for a particular device just like the Device Manager does?
I have the following code:
procedure TdlgMain.Test(const DeviceIndex: Integer);
var
PnPHandle: HDEVINFO;
DevData: TSPDevInfoData;
DeviceInterfaceData: TSPDeviceInterfaceData;
FunctionClassDeviceData: PSPDeviceInterfaceDetailData;
Success: LongBool;
Devn: Integer;
BytesReturned: DWORD;
SerialGUID: TGUID;
begin
ZeroMemory(#DevData, SizeOf(SP_DEVINFO_DATA));
DevData.cbSize := SizeOf(SP_DEVINFO_DATA);
ZeroMemory(#DeviceInterfaceData, SizeOf(TSPDeviceInterfaceData));
DeviceInterfaceData.cbSize := SizeOf(TSPDeviceInterfaceData);
if not SetupDiEnumDeviceInfo(hAllDevices,
DeviceIndex, DevData) then Exit;
SerialGUID := DevData.ClassGuid;
PnPHandle := SetupDiGetClassDevs(#SerialGUID, nil, 0, DIGCF_PRESENT or DIGCF_DEVICEINTERFACE);
if PnPHandle = Pointer(INVALID_HANDLE_VALUE) then
Exit;
Devn := 0;
repeat
DeviceInterfaceData.cbSize := SizeOf(TSPDeviceInterfaceData);
Success := SetupDiEnumDeviceInterfaces(PnPHandle, nil, SerialGUID, Devn, DeviceInterfaceData);
if Success then
begin
DevData.cbSize := SizeOf(DevData);
BytesReturned := 0;
// get size required for call
SetupDiGetDeviceInterfaceDetail(PnPHandle, #DeviceInterfaceData, nil, 0, BytesReturned, #DevData);
if (BytesReturned <> 0) and (GetLastError = ERROR_INSUFFICIENT_BUFFER) then
begin
// allocate buffer and initialize it for call
FunctionClassDeviceData := AllocMem(BytesReturned);
FunctionClassDeviceData.cbSize := SizeOf(TSPDeviceInterfaceDetailData);
//FunctionClassDeviceData.cbSize := BytesReturned;
if SetupDiGetDeviceInterfaceDetail(PnPHandle, #DeviceInterfaceData,
FunctionClassDeviceData, BytesReturned, BytesReturned, #DevData) then
begin
ShowMessage(FunctionClassDeviceData.DevicePath);
end else
RaiseLastOSError();
FreeMem(FunctionClassDeviceData);
end;
end;
Inc(Devn);
until not Success;
SetupDiDestroyDeviceInfoList(PnPHandle);
But the ShowMessage() is either not called at all or returns \. How do I get the files properly?
I had a look at devcon from the WinDDK, but it does not return the files either.
Thank you.
I figured it out. There's no API to do it for you, you need to parse the INF files to achieve the result. Here's a quick-n-dirty solution for all of you, who are interested.
procedure TdlgMain.Test(const DeviceIndex: Integer);
var
Paths: TStringList;
I: Integer;
function GetWinDir: string; inline;
var
dir: array [0 .. MAX_PATH] of Char;
begin
GetWindowsDirectory(dir, MAX_PATH);
Result := IncludeTrailingBackslash(StrPas(dir));
end;
function GetSpecialFolderPath(const folder: Integer): string; inline;
const
SHGFP_TYPE_CURRENT = 0;
var
path: array [0 .. MAX_PATH] of Char;
begin
if SUCCEEDED(SHGetFolderPath(0, folder, 0, SHGFP_TYPE_CURRENT, #path[0]))
then
Result := IncludeTrailingBackslash(path)
else
Result := '';
end;
function LocateInfFile(const F: String): String; inline;
var
T: String;
begin
Result := '';
if (Pos(SysUtils.PathDelim, F) > 0) then
begin
Result := F;
Exit;
end;
T := GetWinDir();
if (FileExists(T + 'inf\' + F)) then
Result := T + 'inf\' + F
else if (FileExists(T + 'system32\' + F)) then
Result := T + 'system32\' + F;
end;
procedure ReadSectionNoKeys(const AFile, ASection: String;
const SL: TStringList);
var
TheFile: TStringList;
Line: String;
TrimEnd: Boolean;
Idx, Tmp: Integer;
begin
TrimEnd := False;
TheFile := TStringList.Create();
try
TheFile.LoadFromFile(AFile);
Idx := TheFile.IndexOf('[' + ASection + ']');
if (Idx <> -1) then
begin
Idx := Idx + 1;
while True do
begin
Line := Trim(TheFile[Idx]);
Inc(Idx);
if (Pos(';', Line) = 1) then
continue;
if (Pos('[', Line) > 0) then
Break;
Tmp := Pos(',', Line);
if (Tmp > 0) then
TrimEnd := True
else
begin
Tmp := PosEx(';', Line, 3);
if (Tmp > 0) then
TrimEnd := True;
end;
if (Line <> '') then
begin
if (TrimEnd) then
begin
Line := Trim(Copy(Line, 1, Tmp - 1));
TrimEnd := False;
end;
SL.Add(Line);
end;
if (Idx = (TheFile.Count - 1)) then
Break;
end;
end;
finally
TheFile.Free();
end;
end;
function IniReadStr(const Ini: TIniFile; const S, L, D: String): String;
var
T: Integer;
begin
Result := Ini.ReadString(S, L, D);
T := Pos(';', Result);
if (T > 0) then
Result := Trim(Copy(Result, 1, T - 1));
end;
procedure ParseInfFile(const InfFile, SectionName: String);
var
I: TIniFile;
SL, FilesList: TStringList;
X, Y, Tmp: Integer;
Pth, S, S1: String;
begin
I := TIniFile.Create(InfFile);
try
if (SectionName <> '') and (I.SectionExists(SectionName)) then
begin
// Check if the section has a value called "CopyFiles".
if (I.ValueExists(SectionName, 'CopyFiles')) then
begin
// It has. Read it to a string and separate by commas.
SL := TStringList.Create();
try
SL.CommaText := IniReadStr(I, SectionName, 'CopyFiles', '');
// Now, every line of the string list is a section name. Check
// the destination directory of each.
if (I.SectionExists('DestinationDirs')) then
for X := 0 to SL.Count - 1 do
begin
S := IniReadStr(I, 'DestinationDirs', SL[X], '');
if (S = '') then
S := IniReadStr(I, 'DestinationDirs', 'DefaultDestDir', '');
if (S <> '') then
begin
// Split the path by comma, if any.
Tmp := Pos(',', S);
S1 := '';
if (Tmp > 0) then
begin
S1 := Trim(Copy(S, Tmp + 1, Length(S)));
S := Trim(Copy(S, 1, Tmp - 1));
end;
// Convert the numeric value of S to a proper directory.
Pth := '';
if (S = '10') then
Pth := GetWinDir();
if (S = '11') then
Pth := GetWinDir() + 'system32\';
if (S = '12') then
Pth := GetWinDir() + 'system32\drivers\';
if (S = '50') then
Pth := GetWinDir() + 'system\';
if (S = '30') then
Pth := ExtractFileDrive(GetWinDir());
if (StrToInt(S) >= 16384) then
Pth := GetSpecialFolderPath(StrToInt(S));
if (S1 <> '') then
Pth := IncludeTrailingBackslash(Pth + S1);
// If we got the path, read the files.
if (Pth <> '') then
begin
FilesList := TStringList.Create();
try
ReadSectionNoKeys(InfFile, SL[X], FilesList);
for Y := 0 to FilesList.Count - 1 do
if (Paths.IndexOf(Pth + FilesList[Y]) = -1) then
Paths.Add(Pth + FilesList[Y]);
finally
FilesList.Free();
end;
end;
end;
end;
finally
SL.Free();
end;
end;
// Check if there're "Include" and "Needs" values.
if ((I.ValueExists(SectionName, 'Include')) and
(I.ValueExists(SectionName, 'Needs'))) then
begin
// Split both by comma.
SL := TStringList.Create();
FilesList := TStringList.Create();
try
SL.CommaText := IniReadStr(I, SectionName, 'Include', '');
FilesList.CommaText := IniReadStr(I, SectionName, 'Needs', '');
if (SL.Text <> '') and (FilesList.Text <> '') then
for X := 0 to SL.Count - 1 do
for Y := 0 to FilesList.Count - 1 do
ParseInfFile(LocateInfFile(SL[X]), FilesList[Y]);
finally
FilesList.Free();
SL.Free();
end;
end;
end;
finally
I.Free();
end;
end;
begin
Paths := TStringList.Create();
try
ParseInfFile(LocateInfFile(DeviceHelper.InfName), DeviceHelper.InfSection);
Paths.Sort();
ListView_InsertGroup(lvAdvancedInfo.Handle, 'Driver Files', 2);
for I := 0 to Paths.Count - 1 do
ListView_AddItemsInGroup(lvAdvancedInfo, '', Paths[I], 2);
finally
Paths.Free();
end;
end;