I am using this function and need reverse one. Its converting HEX (unicode) string to unicode (WideString). I need reverse function to convert it back, i.e. Widestring back to HEX (unicode).
function _ConvertHexToWideString(AHex: AnsiString): WideString;
var wBinaryStream: TMemoryStream;
begin
try
wBinaryStream := TMemoryStream.Create;
try
wBinaryStream.Size := Length(AHex) div 2;
if wBinaryStream.Size > 0 then
HexToBin(PAnsiChar(AHex), wBinaryStream.Memory, wBinaryStream.Size);
except
end;
SetString(Result,
PWideChar(wBinaryStream.Memory),
wBinaryStream.Size div SizeOf(WideChar));
finally
FreeAndNil(wBinaryStream);
end;
end;
You simply do the opposite, using BinToHex() instead, eg:
function _ConvertWideStringToHex(AStr: WideString): AnsiString;
var
wBinaryStream: TMemoryStream;
iBufSize: Integer;
begin
try
wBinaryStream := TMemoryStream.Create;
try
iBufSize := Length(AStr) * SizeOf(WideChar);
wBinaryStream.Size := iBufSize * 2;
if iBufSize > 0 then
BinToHex(PAnsiChar(Pointer(AStr)), PAnsiChar(wBinaryStream.Memory), iBufSize);
except
end;
SetString(Result,
PAnsiChar(wBinaryStream.Memory),
wBinaryStream.Size div SizeOf(AnsiChar));
finally
FreeAndNil(wBinaryStream);
end;
end;
Which can be simplified to this:
function _ConvertWideStringToHex(AStr: WideString): AnsiString;
var
iBufSize: Integer;
begin
iBufSize := Length(AStr) * SizeOf(WideChar);
if iBufSize > 0 then begin
SetLength(Result, iBufSize * 2);
BinToHex(PAnsiChar(Pointer(AStr)), PAnsiChar(Result), iBufSize);
end else
Result := '';
end;
Related
So i'm working on this pascal application which has a menu where you can do multiple things.
After entering an album (which is what my program does) and trying to edit it by writing over the current album I get an error as shown in the image.
There have been no errors when compiling except the warning:
(100,9) Warning: Function result variable does not seem to initialized
Here is my code:
program MusicPlayer;
uses TerminalUserInput;
type
// You should have a track record
TrackRec = record
name: String;
location: String;
end;
type TrackArray = array of TrackRec;
GenreType = (Pop, Rap, Rock, Classic);
AlbumRec = Record
name: String;
genre: GenreType;
location: array of TrackRec; // this and track should be track: array of TrackRec
numberOfTracks: Integer;
tracks: TrackArray;
end;
type AlbumArray = array of AlbumRec; // this should be an array of AlbumRec
function ReadGenre(prompt: String): GenreType;
var
option: Integer;
begin
WriteLn('Press 1 for Pop');
WriteLn('Press 2 for Rap');
WriteLn('Press 3 for Rock');
WriteLn('Press 4 for Classic');
option := ReadInteger(prompt);
while (option<1) or (option>3) do
begin
WriteLn('Please enter a number between 1-4');
option := ReadInteger(prompt);
end;
case option of
1: result := Pop;
2: result := Rap;
3: result := Rock;
else
result := Classic;
end;
end;
function CheckLength(prompt: string): Integer;
var
i: Integer;
begin
i := ReadInteger(prompt);
while (i < 0) or (i > 20) do
begin
WriteLn('Please enter a number between 1-20');
i := ReadInteger(prompt);
end;
result := i;
end;
function ReadTracks(count: Integer): TrackArray;
var
i: Integer;
begin
setLength(result, count);
for i := 0 to High(result) do
begin
result[i].name := ReadString('Track Name: ');
result[i].location := ReadString('Track Location: ');
end;
end;
function ReadAlbum(): AlbumRec;
begin
result.name := ReadString('What is the name of the album?');
result.genre := ReadGenre('What is the genre of the album?');
result.numberOfTracks := CheckLength('How many tracks are in the album?');
result.tracks := ReadTracks(result.numberOfTracks);
end;
function ReadAlbums(count: Integer): AlbumArray;
var
i: Integer;
begin
SetLength(result, count);
for i := 0 to High(result) do
begin
result[i] := ReadAlbum();
end;
end;
function ChangeAlbum(count: Integer): AlbumArray;
var
i: Integer;
begin
for i := count to count do
begin
result[i] := ReadAlbum();
end;
end;
procedure PrintAlbum(count: Integer; album: array of AlbumRec);
var
i: Integer;
begin
if count = 1 then
begin
for i := 0 to High(album) do
begin
WriteLn('Album Number: ', i);
WriteLn('Album name is: ', album[i].name);
WriteLn('Album genre is: ', album[i].genre);
end
end;
for i := 1 to count - 1 do
begin
WriteLn('Album name is: ', album[i].name);
WriteLn('Album genre is: ', album[i].genre);
end;
end;
procedure PrintTrack(tracks: TrackArray);
var
i: Integer;
begin
i := ReadInteger('Which track number do you wish to play?');
i := i - 1;
WriteLn('Now playing track: ', tracks[i].name);
WriteLn('Track location: ', tracks[i].location);
end;
function CheckIfFinished(): Boolean;
var answer: String;
begin
WriteLn('Do you want to enter another set of tracks? ');
ReadLn(answer);
LowerCase(answer);
case answer of
'no': result := true;
'n': result := true;
'x': result := true;
else
result := false;
end;
end;
procedure Main();
var
i, count, select, change: Integer;
albums: AlbumArray;
begin
WriteLn('Please select an option: ');
WriteLn('-------------------------');
WriteLn('1. Read Albums');
WriteLn('2. Display Albums');
WriteLn('3. Select an Album');
WriteLn('4. Update an Album');
WriteLn('5. Exit');
WriteLn('-------------------------');
repeat
i := ReadInteger('Your Option:');
case i of
1:
begin
count := ReadInteger('How many albums: ');
albums := ReadAlbums(count);
end;
2:
begin
WriteLn('1. Display All Albums');
WriteLn('2. Display All Albums by Genre');
select := ReadInteger('Your Option: ');
if i = 1 then
begin
PrintAlbum(select, albums);
end;
// if i = 2 then
// WriteLn('1. Pop');
// WriteLn('2. Rap');
// WriteLn('3. Rock');
// WriteLn('4. Classic');
// albums := ReadAlbums(count);
end;
3:
begin
select := ReadInteger('Which album would you like to play? ');
PrintAlbum(select, albums);
PrintTrack(albums[select-1].tracks);
end;
4:
begin
change := ReadInteger('Which album would you like to edit?');
albums := ChangeAlbum(change);
end;
end;
until i = 5;
end;
begin
Main();
end.
The function that the warning refers to, on line 100, is
function ChangeAlbum(count: Integer): AlbumArray;
var
i: Integer;
begin
for i := count to count do
begin
result[i] := ReadAlbum();
end;
end;
The warning says:
Warning: Function result variable does not seem to initialized
And indeed the result variable has not been initialized.
The design of the function is wrong though. You are trying to modify an existing element in an array. You should not be returning a new array. The function is not necessary though. You should simply remove it. Then you need to look at the one place where you call the function.
change := ReadInteger('Which album would you like to edit?');
albums := ChangeAlbum(change);
You should instead code that like this:
change := ReadInteger('Which album would you like to edit?');
albums[change] := ReadAlbum();
I've not checked anything else in your program. I would not be surprised if there are other problems. I've just tried to address the specific question that you asked.
Is it possible to obtain information about the Windows Explorer tree (what nodes are currently expanded, when a node is expanded etc.)?
Starting from Vista there is official way to communicate with tree in Explorer window. This way uses INameSpaceTreeControl interface.
If you want to get INameSpaceTreeControl from external app you must:
1) Get IDispatch of shell window:
var
ShellWindows: IShellWindows;
i: Integer;
Dispatch: IDispatch;
SL: TStrings;
begin
OleCheck(CoCreateInstance(CLASS_ShellWindows, nil, CLSCTX_INPROC_SERVER or CLSCTX_LOCAL_SERVER, IShellWindows, ShellWindows));
try
for i := ShellWindows.Count - 1 downto 0 do
begin
Dispatch := ShellWindows.Item(i);
try
SL := CreateNodeList(Dispatch);
try
Memo1.Lines.Assign(SL);
finally
SL.Free;
end;
Exit;
finally
Dispatch := nil;
end;
end;
finally
ShellWindows := nil;
end;
end;
2) Query IServiceProvider from IDispatch.
3) Query INameSpaceTreeControl from IServiceProvider.
4) After this you can enum elements of tree. I used the following algorithm:
function GetItemName(AShellItem: IShellItem): UnicodeString;
var
Name: PWideChar;
begin
OleCheck(AShellItem.GetDisplayName(SIGDN_NORMALDISPLAY, Name));
try
Result := Name;
finally
CoTaskMemFree(Name);
end;
end;
function GetLevelSpaces(ALevel: Integer): UnicodeString;
var
i: Integer;
begin
Result := '';
for i := 0 to ALevel - 1 do
Result := Result + ' ';
end;
function CalcLavel(AShellItem: IShellItem): Integer;
var Parent: IShellItem;
begin
Result := 0;
if Succeeded(AShellItem.GetParent(Parent)) then
try
Inc(Result);
Result := Result + CalcLavel(Parent);
finally
Parent := nil;
end;
end;
function GetExpanded(ATree: INameSpaceTreeControl; AItem: IShellItem): WideChar;
var
State: DWORD;
begin
OleCheck(ATree.GetItemState(AItem, NSTCIS_EXPANDED, State));
if State and NSTCIS_EXPANDED <> 0 then Result := '+'
else Result := '-';
end;
function CreateNodeList(ADispatch: IDispatch): TStrings;
var
ServiceProvider: IServiceProvider;
Tree: INameSpaceTreeControl;
L: Integer;
ShellItem, ShellItem2: IShellItem;
begin
OleCheck(ADispatch.QueryInterface(IServiceProvider, ServiceProvider));
try
OleCheck(ServiceProvider.QueryService(SID_SNavigationPane, INameSpaceTreeControl, Tree));
try
Result := TStringList.Create;
try
if Succeeded(Tree.GetNextItem(nil, NSTCGNI_CHILD, ShellItem)) then
repeat
try
L := CalcLavel(ShellItem);
Result.Add(GetLevelSpaces(L - 1) + GetExpanded(Tree, ShellItem) + ' ' + GetItemName(ShellItem));
finally
ShellItem2 := ShellItem;
ShellItem := nil;
end;
until Failed(Tree.GetNextItem(ShellItem2, NSTCGNI_NEXTVISIBLE, ShellItem));
finally
ShellItem2 := nil;
end;
finally
Tree := nil;
end;
finally
ServiceProvider := nil;
end;
end;
Result:
If you want to subscribe to tree actions use INameSpaceTreeControl.TreeAdvise.
I'm using Delphi 5 + BDE + Oracle. I have the following function:
class function TClientDataSetFactory.GetClientDataSet(
const qryGen: TDataSet): TClientDataSet;
var
dspDados: TDataSetProvider;
begin
Result := nil;
try
try
Result := TClientDataSet.Create(nil);
dspDados := TDataSetProvider.Create(Result);
dspDados.DataSet := qryGen;
qryGen.Active := True;
qryGen.First;
Result.Data := dspDados.Data;
Result.First;
except
on E: Exception do
begin
raise;
end;
end;
finally
end;
end;
so, when a run this:
var
qryGen: TQuery;
cdsGen: TClientDataSet;
begin
qryGen := nil;
try
try
qryGen := CriaQuery();
qryGen.SQL.Text :=
'SELECT SUM(TOTAL) AS TOTAL FROM MYTABLE';
cdsGen := TClientDataSetFactory.GetClientDataSet(qryGen);
ShowMessageFmt('Total: %f', [cdsGen.FieldByName('TOTAL').AsFloat]);
except
on E: Exception do
begin
raise;
end;
end;
finally
if Assigned(qryGen) then FreeAndNil(qryGen);
end;
end;
i got "159,00" but, if i run this:
ShowMessageFmt('Total: %f', [qryGen.FieldByName('TOTAL').AsFloat]);
i got "159,25".
can someone help me?
I solved the problem with another solution.
type
TInternalQuery = class(TQuery)
protected
procedure InternalInitFieldDefs; override;
public
constructor Create(AOwner: TComponent; const qryGen: TQuery); reintroduce;
end;
constructor TInternalQuery.Create(AOwner: TComponent; const qryGen: TQuery);
var
intCont: Integer;
begin
inherited Create(AOwner);
Self.DatabaseName := qryGen.DatabaseName;
Self.UpdateObject := qryGen.UpdateObject;
Self.SQL.Text := qryGen.SQL.Text;
for intCont := 0 to Self.ParamCount - 1 do
begin
Self.Params[intCont].Value := qryGen.Params[intCont].Value;
end;
end;
procedure TInternalQuery.InternalInitFieldDefs;
var
intCont: Integer;
begin
inherited InternalInitFieldDefs;
for intCont := 0 to FieldDefs.Count - 1 do
begin
if (FieldDefs[intCont].Size = 0) and (FieldDefs[intCont].DataType = ftBCD) then
begin
FieldDefs[intCont].Precision := 64;
FieldDefs[intCont].Size := 32;
end;
end;
end;
the problem is ((FieldDefs[intCont].Size = 0) and (FieldDefs[intCont].DataType = ftBCD)). when ClientDataSet is created, the field is truncated, because when oracle has a function like "SUM(TOTAL)" the result field is created with size 0, so the clientdataset handle the field as Integer field.
Try with
ShowMessageFmt('Total: %n', [cdsGen.FieldByName('TOTAL').AsFloat])
or this
cdsGen := TClientDataSetFactory.GetClientDataSet(qryGen);
**(cdsGen.FieldByName('Total') as TFloatField).DisplayFormat := '0.00';**
ShowMessageFmt('Total: %f', [cdsGen.FieldByName('TOTAL').AsFloat])
I want to convert a String to a byte array, the code looks like the following:
procedure StringToByteArray(const s : String; var tmp: array of Byte);
var
i : integer;
begin
For i:=1 to Length(s) do
begin
tmp[i-1] := Ord(s[i]);
end;
end;
s[i] here is the i'th String element (= char at pos i) and I'm saving its numerical value to tmp.
This works for some characters, but not for all, for example:
Ord('•') returns Dec(149), which is what I expect.
But in my procedure Ord(s[i]) returns Dec(8226) for the same character!
Edit1: I think the defect lies in my other function "ByteArrayToStr"
When converting ...
tmp:= 149 // tmp is of type byte
Log('experiment: ' + Chr(tmp)); // prints "•"
Log('experiment2 ' + IntToStr(Ord(Chr(tmp)))); // prints 149
... back and forth, this seems to work.
But using the same conversion in the following function won't do it:
function ByteArrayToStr( a : array of Byte ) : String;
var
S:String;
I:integer;
begin
S:='';
For I:=0 to Length(a) -1 do
begin
tmp := Chr(a[I]) ; // for a[I] equals 149 this will get me "?" instead of "•"
S:=S+tmp;
end;
Result:=S;
end;
To make it clear: ByteArrayToStr does not convert Ord(149) to "•" as expected, and therefore StringToByteArray won't work later on
You need to turn your parameters into AnsiString type. By doing so, you can write functions like this:
[Setup]
AppName=My Program
AppVersion=1.5
DefaultDirName={pf}\My Program
OutputDir=userdocs:Inno Setup Examples Output
[Code]
procedure StringToByteArray(const S: AnsiString; out ByteArray: array of Byte);
var
I: Integer;
begin
SetArrayLength(ByteArray, Length(S));
for I := 1 to Length(S) do
ByteArray[I - 1] := Ord(S[I]);
end;
function ByteArrayToString(const ByteArray: array of Byte): AnsiString;
var
I: Integer;
begin
SetLength(Result, GetArrayLength(ByteArray));
for I := 1 to GetArrayLength(ByteArray) do
Result[I] := Chr(ByteArray[I - 1]);
end;
procedure InitializeWizard;
var
S: AnsiString;
ByteArray: array of Byte;
begin
S := '•';
StringToByteArray(S, ByteArray);
MsgBox(IntToStr(ByteArray[0]), mbInformation, MB_OK);
S := '';
S := ByteArrayToString(ByteArray);
MsgBox(S, mbInformation, MB_OK);
end;
I'm maintaining an old code base that's using waveOutGetDevCaps to get the names of the audio devices on the system. On Windows 7 machines this results in truncated names, as WAVEOUTCAPS.szPname is limited by MAXPNAMELEN (31 chars).
What's the Win7 way of doing this?
You could use one of the Core Audio APIs:
// get the device enumerator
IMMDeviceEnumerator* pEnumerator = NULL;
HRESULT hr = CoCreateInstance(__uuidof(MMDeviceEnumerator), NULL,
CLSCTX_ALL,__uuidof(IMMDeviceEnumerator),
(void**)&pEnumerator);
// get the endpoint collection
IMMDeviceCollection* pCollection = NULL;
DWORD mask = DEVICE_STATE_ACTIVE || DEVICE_STATE_UNPLUGGED;
hr = pEnumerator->EnumAudioEndpoints(eRender, mask, &pCollection);
// get the size of the collection
UINT count = 0;
hr = pCollection->GetCount(&count);
for (int i = 0; i < (int)count; i++)
{
// get the endpoint
IMMDevice* pEndPoint = NULL;
hr = pCollection->Item(i, &pEndPoint);
// get the human readable name
String^ friendlyName;
IPropertyStore* pProps = NULL;
HRESULT hr = pEndPoint->OpenPropertyStore(STGM_READ, &pProps);
PROPVARIANT varName;
PropVariantInit(&varName);
hr = pProps->GetValue(PKEY_Device_FriendlyName, &varName);
friendlyName = gcnew String(varName.pwszVal);
PropVariantClear(&varName);
}
Error handling was removed in the above code to make it more readable. (I happen to love using C++/CLI to move between C# and the Windows APIs.)
Now the harder part will be to relate the endpoint names to the MME devices in your old code base.
I have found another way using the registry to find audio devices' full name, both Input and Output.
Works on Windows 7 and Windows 10.
procedure TForm_Config.FormCreate(Sender: TObject);
type
tagWAVEOUTCAPS2A = packed record
wMid: WORD;
wPid: WORD;
vDriverVersion: MMVERSION;
szPname: array[0..MAXPNAMELEN-1] of AnsiChar;
dwFormats: DWORD;
wChannels: WORD;
wReserved1: WORD;
dwSupport: DWORD;
ManufacturerGuid: System.TGUID;
ProductGuid: System.TGUID;
NameGuid: System.TGUID;
end;
var
i,outdevs: Integer;
woCaps: tagWAVEOUTCAPS2A;
RegistryService: TRegistry;
iClasses, iSubClasses, iNames: Integer;
audioDeviceClasses, audioDeviceSubClasses, audioDeviceNames: TStringList;
initialDeviceName, partialDeviceName, fullDeviceName: string;
begin
audioDeviceClasses := TStringList.Create;
audioDeviceSubClasses := TStringList.Create;
audioDeviceNames := TStringList.Create;
try
RegistryService := TRegistry.Create;
try
RegistryService.RootKey := HKEY_LOCAL_MACHINE;
if RegistryService.OpenKeyReadOnly('\SYSTEM\CurrentControlSet\Enum\HDAUDIO\') then begin
RegistryService.GetKeyNames(audioDeviceClasses);
RegistryService.CloseKey();
for iClasses := 0 to audioDeviceClasses.Count - 1 do begin
if RegistryService.OpenKeyReadOnly('\SYSTEM\CurrentControlSet\Enum\HDAUDIO\'+audioDeviceClasses[iClasses]) then begin
RegistryService.GetKeyNames(audioDeviceSubClasses);
RegistryService.CloseKey();
for iSubClasses := 0 to audioDeviceSubClasses.Count - 1 do begin
if RegistryService.OpenKeyReadOnly('\SYSTEM\CurrentControlSet\Enum\HDAUDIO\'+audioDeviceClasses[iClasses]+'\'+audioDeviceSubClasses[iSubClasses]) then begin
if RegistryService.ValueExists('DeviceDesc') then begin
fullDeviceName := Trim(RegistryService.ReadString('DeviceDesc'));
if AnsiPos(';',fullDeviceName) > 0 then begin
fullDeviceName := Trim(AnsiMidStr(fullDeviceName, AnsiPos(';',fullDeviceName)+1, Length(fullDeviceName)));
end;
audioDeviceNames.Add(fullDeviceName);
end;
RegistryService.CloseKey();
end;
end;
end;
end;
end;
finally
FreeAndNil(RegistryService);
end;
// WaveOutDevComboBox is a selection box (combo) placed in the form and will receive the list of output audio devices
WaveOutDevComboBox.Clear;
try
outdevs := waveOutGetNumDevs;
for i := 0 to outdevs - 1 do begin
ZeroMemory(#woCaps, sizeof(woCaps));
if waveOutGetDevCaps(i, #woCaps, sizeof(woCaps)) = MMSYSERR_NOERROR then begin
RegistryService := TRegistry.Create;
try
RegistryService.RootKey := HKEY_LOCAL_MACHINE;
if RegistryService.OpenKeyReadOnly('\System\CurrentControlSet\Control\MediaCategories\' + GUIDToString(woCaps.NameGuid)) then begin
WaveOutDevComboBox.Items.Add(RegistryService.ReadString('Name'));
RegistryService.CloseKey();
end
else begin
initialDeviceName := '';
partialDeviceName := Trim(woCaps.szPname);
if AnsiPos('(',partialDeviceName) > 0 then begin
initialDeviceName := Trim(AnsiLeftStr(partialDeviceName,AnsiPos('(',partialDeviceName)-1));
partialDeviceName := Trim(AnsiMidStr(partialDeviceName,AnsiPos('(',partialDeviceName)+1,Length(partialDeviceName)));
if AnsiPos(')',partialDeviceName) > 0 then begin
partialDeviceName := Trim(AnsiLeftStr(partialDeviceName,AnsiPos(')',partialDeviceName)-1));
end;
end;
for iNames := 0 to audioDeviceNames.Count - 1 do begin
fullDeviceName := audioDeviceNames[iNames];
if AnsiStartsText(partialDeviceName,fullDeviceName) then begin
break;
end
else begin
fullDeviceName := partialDeviceName;
end;
end;
WaveOutDevComboBox.Items.Add(initialDeviceName + IfThen(initialDeviceName<>EmptyStr,' (','') + fullDeviceName + IfThen(initialDeviceName<>EmptyStr,')',''));
end;
finally
FreeAndNil(RegistryService);
end;
end;
end;
except
WaveOutDevComboBox.Enabled := False;
end;
finally
FreeAndNil(audioDeviceClasses);
FreeAndNil(audioDeviceSubClasses);
FreeAndNil(audioDeviceNames);
end;
end;