In Delphi 7 I'm working on a library implementing an object encapsulating information about the batteries attached to a system. It's working well, except for retrieving the serial number for the battery.
The code I am using for this call is as follows:
function TBattery.GetSerialNumber(hbat: THandle): boolean;
var
bqi: TBatteryQueryInformation;
Serial: PWideChar;
SerialSize,
dwOut: DWORD;
begin
Result := False;
if hbat <> INVALID_HANDLE_VALUE then
begin
ZeroMemory(#bqi, SizeOf(bqi));
dwOut := 0;
bqi.BatteryTag := FBatteryTag;
bqi.InformationLevel := BatterySerialNumber;
SerialSize := 2048;
GetMem(Serial, SerialSize);
try
ZeroMemory(Serial, SerialSize);
Result := DeviceIoControl(hbat, IOCTL_BATTERY_QUERY_INFORMATION, #bqi,
SizeOf(bqi), Serial, SerialSize, #dwOut, nil);
if Result then
FSerialNumber := Serial;
finally
FreeMem(Serial, SerialSize);
end;
end;
end;
Unfortunately, DeviceIoControl() always returns False and if I check GetLastError() afterwards then it comes back with error 87, "the parameter is incorrect."
This doesn't make much sense, because the code works perfectly well if I simply change the InformationLevel from BatterySerialNumber to BatteryUniqueID, say. Also, I've used the handle to the battery (hbat) in other calls in the code before GetSerialNumber and they all work fine, and I can call others after this one fails as well, so that's not the issue.
Any ideas? I'm really at a loss.
The issue it seems related to the dwOut variable which is passed as #dwOut, this variable represents the var lpBytesReturned parameter of the DeviceIoControl which is defined as
function DeviceIoControl(hDevice: THandle; dwIoControlCode: DWORD; lpInBuffer: Pointer;
nInBufferSize: DWORD; lpOutBuffer: Pointer; nOutBufferSize: DWORD;
var lpBytesReturned: DWORD; lpOverlapped: POverlapped): BOOL; stdcall;
So replacing your code by
Result := DeviceIoControl(hbat, IOCTL_BATTERY_QUERY_INFORMATION, #bqi,
SizeOf(bqi), Serial, SerialSize, dwOut, nil);
Must fix the problem.
WinAPI
Also check this code translated to delphi from this msdn entry Enumerating Battery Devices which can help you to detect any additional issues with your code.
uses
SetupApi,
Windows,
SysUtils;
type
BATTERY_QUERY_INFORMATION_LEVEL = (
BatteryInformation,
BatteryGranularityInformation,
BatteryTemperature,
BatteryEstimatedTime,
BatteryDeviceName,
BatteryManufactureDate,
BatteryManufactureName,
BatteryUniqueID,
BatterySerialNumber);
TBatteryQueryInformationLevel = BATTERY_QUERY_INFORMATION_LEVEL;
_BATTERY_QUERY_INFORMATION = record
BatteryTag: ULONG;
InformationLevel: BATTERY_QUERY_INFORMATION_LEVEL;
AtRate: Longint;
end;
BATTERY_QUERY_INFORMATION = _BATTERY_QUERY_INFORMATION;
PBATTERY_QUERY_INFORMATION = ^BATTERY_QUERY_INFORMATION;
TBatteryQueryInformation = BATTERY_QUERY_INFORMATION;
const
GUID_DEVCLASS_BATTERY:TGUID='{72631E54-78A4-11D0-BCF7-00AA00B7B32A}';
//DEFINE_GUID( GUID_DEVCLASS_BATTERY, 0x72631E54, 0x78A4, 0x11D0, 0xBC, 0xF7, 0x00, 0xAA, 0x00, 0xB7, 0xB3, 0x2A );
METHOD_BUFFERED = 0;
FILE_DEVICE_BATTERY = $00000029;
FILE_READ_ACCESS = $0001; // for files and pipes
IOCTL_BATTERY_QUERY_TAG =
(FILE_DEVICE_BATTERY shl 16) or (FILE_READ_ACCESS shl 14) or ($10 shl 2) or (METHOD_BUFFERED);
IOCTL_BATTERY_QUERY_INFORMATION =
(FILE_DEVICE_BATTERY shl 16) or (FILE_READ_ACCESS shl 14) or ($11 shl 2) or (METHOD_BUFFERED);
function GetBatteryInfo(InformationLevel : BATTERY_QUERY_INFORMATION_LEVEL) : string;
var
cbRequired : DWORD;
hdev : HDEVINFO;
idev : Integer;
did : TSPDeviceInterfaceData;
pdidd : PSPDeviceInterfaceDetailData;
hBattery : THandle;
bqi : TBatteryQueryInformation;
dwWait, dwOut : DWORD;
lpOutBuffer: PWideChar;
begin
// enumerate the batteries
hdev := SetupDiGetClassDevs(#GUID_DEVCLASS_BATTERY, nil, 0, DIGCF_PRESENT OR DIGCF_DEVICEINTERFACE);
if ( INVALID_HANDLE_VALUE <> THandle(hdev) ) then
begin
idev:=0;//first battery
ZeroMemory(#did, SizeOf(did));
did.cbSize := SizeOf(did);
if (SetupDiEnumDeviceInterfaces(hdev, nil, GUID_DEVCLASS_BATTERY, idev, did)) then
begin
try
cbRequired := 0;
SetupDiGetDeviceInterfaceDetail(hdev, #did, nil, 0, cbRequired, nil);
if (ERROR_INSUFFICIENT_BUFFER= GetLastError()) then
begin
pdidd:=AllocMem(cbRequired);
try
pdidd.cbSize := SizeOf(TSPDeviceInterfaceDetailData);
if (SetupDiGetDeviceInterfaceDetail(hdev, #did, pdidd, cbRequired, cbRequired, nil)) then
begin
hBattery :=CreateFile(pdidd.DevicePath, GENERIC_READ OR GENERIC_WRITE, FILE_SHARE_READ OR FILE_SHARE_WRITE, nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0);
if (INVALID_HANDLE_VALUE <> hBattery) then
begin
try
ZeroMemory(#bqi, SizeOf(bqi));
// With the tag, you can query the battery info.
dwWait := 0;
if (DeviceIoControl(hBattery, IOCTL_BATTERY_QUERY_TAG, #dwWait, sizeof(dwWait), #bqi.BatteryTag, sizeof(bqi.BatteryTag), dwOut, nil)) then
begin
lpOutBuffer:=AllocMem(MAX_PATH);
try
ZeroMemory(lpOutBuffer,MAX_PATH);
bqi.InformationLevel:=InformationLevel;
if DeviceIoControl(hBattery, IOCTL_BATTERY_QUERY_INFORMATION, #bqi, SizeOf(BATTERY_QUERY_INFORMATION), lpOutBuffer, 255, dwOut,nil) then
Result:= WideCharToString(lpOutBuffer);
finally
FreeMem(lpOutBuffer);
end;
end;
finally
CloseHandle(hBattery)
end;
end;
end;
finally
FreeMem(pdidd);
end;
end;
finally
SetupDiDestroyDeviceInfoList(hdev);
end;
end;
end;
end;
begin
try
if not LoadsetupAPI then exit;
Writeln(GetBatteryInfo(BatterySerialNumber));
except
on E: Exception do
Writeln(E.ClassName, ': ', E.Message);
end;
readln;
end.
WMI
Finally as aside note, you can use the WMI to retrieve the same info, in this case using the BatteryStaticData WMI class
{$APPTYPE CONSOLE}
uses
SysUtils,
ActiveX,
ComObj,
Variants;
// Battery Static Data
procedure GetBatteryStaticDataInfo;
const
WbemUser ='';
WbemPassword ='';
WbemComputer ='localhost';
wbemFlagForwardOnly = $00000020;
var
FSWbemLocator : OLEVariant;
FWMIService : OLEVariant;
FWbemObjectSet: OLEVariant;
FWbemObject : OLEVariant;
oEnum : IEnumvariant;
iValue : LongWord;
begin;
FSWbemLocator := CreateOleObject('WbemScripting.SWbemLocator');
FWMIService := FSWbemLocator.ConnectServer(WbemComputer, 'root\WMI', WbemUser, WbemPassword);
FWbemObjectSet:= FWMIService.ExecQuery('SELECT SerialNumber FROM BatteryStaticData','WQL',wbemFlagForwardOnly);
oEnum := IUnknown(FWbemObjectSet._NewEnum) as IEnumVariant;
while oEnum.Next(1, FWbemObject, iValue) = 0 do
begin
Writeln(Format('SerialNumber %s',[String(FWbemObject.SerialNumber)]));// String
Writeln('');
FWbemObject:=Unassigned;
end;
end;
begin
try
CoInitialize(nil);
try
GetBatteryStaticDataInfo;
finally
CoUninitialize;
end;
except
on E:EOleException do
Writeln(Format('EOleException %s %x', [E.Message,E.ErrorCode]));
on E:Exception do
Writeln(E.Classname, ':', E.Message);
end;
Writeln('Press Enter to exit');
Readln;
end.
In summary, the code #RRUZ and I posted work fine under Windows 7, as well as other third-party applications. They do not work for retrieving the serial number under Windows XP. I've also tested under WinXP and 7 with base installs of the OS on the exact same hardware, with identical results (success under Windows 7, not under windows XP).
It appears that under WinXP the value BatterySerialNumber for IOCTL_BATTERY_QUERY_INFORMATION's InformationLevel member is not supported, but this is not documented directly in the Windows SDK docs. It is documented that invalid entries should return error 1 (ERROR_INVALID_FUNCTION) for GetLastError(), but in this case is returning 87 (for an invalid parameter) instead. I posit that this is because that value in the enumeration is not valid, so it makes the parameter invalid, but I'm not exactly sure.
Thanks to all for their help, especially #RRUZ for going way above and beyond!
(As an aside, it appears that one can extract the serial number from the battery's Unique ID (Using BatteryUniqueID as the InformationLevel member) and removing the manufacturer name and device name from the unique ID. That's a terrible hack, but it's a semi-viable workaround for Windows XP.)
Related
Good afternoon,
I need lock CTRL+ALT+DEL combination using SetWindowsHookEx and today i have done a code and don't is working until now.
This code is executing in a dll ( this dll is my software ) that is injected in other process.
So, how i can adapt this code below to work?
const
WH_KEYBOARD_LL = 13;
LLKHF_ALTDOWN = $20;
type
KBDLLHOOKSTRUCT = record
vkCode: DWORD;
scanCode: DWORD;
flags: DWORD;
time: DWORD;
dwExtraInfo: Longint ;
end;
var
hhkLowLevelKybd : HHOOK;
FoldProc : LongInt;
hSASWnd : HWND;
hThread : Cardinal;
{$R *.dfm}
Function LowLevelKeyboardProc(nCode : Integer; wParam : Longint; var LParam: KBDLLHOOKSTRUCT) : Longint; stdcall;
var
fEatKeystroke : Boolean;
dwThreadId : Cardinal;
begin
If (nCode = HC_ACTION) Then
begin
If (wParam = WM_KEYDOWN) Or
(wParam = WM_SYSKEYDOWN) Or
(wParam = WM_KEYUP) Or
(wParam = WM_SYSKEYUP) Then
begin
fEatKeystroke :=
(((GetKeyState(VK_CONTROL) And $8000) <> 0) And
((LParam.flags And LLKHF_ALTDOWN ) <> 0) And
(LParam.vkCode = VK_DELETE));
End;
If fEatKeystroke Then
Result := -1
Else
Result := CallNextHookEx(0, nCode, wParam, LongInt(#LParam));
End;
end;
////////// FormCreate event here ///////////
hhkLowLevelKybd := 0;
hhkLowLevelKybd := SetWindowsHookEx(WH_KEYBOARD_LL, #LowLevelKeyboardProc,
HInstance, 0);
end.
Windows does not allow you to intercept Ctrl+Alt+Del for security reasons. Earlier versions (pre-Vista?) used to allow it by replacing the GINA DLL, but it's not been allowed for years.
That key combination is known as a secure attention sequence which is guaranteed to be trustworthy as part of the login process.
If your goal is to only allow your application to be run, you can configure it to act in kiosk mode if you're running a suitable version of Windows, as shown in Set up a device for anyone to use (kiosk mode) at TechNet which #LURD kindly provided.
By design it's impossible to trap or block Ctrl+Alt+Del (The Secure Attention Sequence). There is however a commercial library available (disclaimer: I am the author), SasLibEx.
SasLibEx: a library that can simulate or block the Secure Attention
Sequence (Ctrl+Alt+Del) but it can even unlock a
workstation or session without entering or needing the user’s
credentials (and many more things)
See this screencast for a demo.
Impossible. The Ctl-Alt-Del gets trapped in the Kernel and never makes it to the user mode space where your app is running.
I have had to do this on kiosks systems (using Win XP and Vista) and I did it with a keyboard filter driver (which runs in the kernel) that swaps out the scan codes when the key are pressed.
Not is impossible, see the following code:
program Project1;
{$APPTYPE CONSOLE}
{$R *.res}
uses
SysUtils,
Windows,
Registry,
vcl.Dialogs;
procedure DisableCtrAltDel(boolState: Boolean);
var
SystemReg: TRegistry;
Data: Array [1 .. 48] of Byte;
i: Byte;
begin
try
for i := 1 to 48 do
Data[i] := $00;
Data[9] := $09;
Data[15] := $5B;
Data[16] := $E0;
Data[19] := $5C;
Data[20] := $E0;
Data[23] := $5D;
Data[24] := $E0;
Data[27] := $44;
Data[31] := $1D;
Data[35] := $38;
Data[39] := $1D;
Data[40] := $E0;
Data[43] := $38;
Data[44] := $E0;
try
SystemReg := TRegistry.Create;
with SystemReg do
begin
RootKey := HKEY_LOCAL_MACHINE;
OpenKey('\System\CurrentControlSet\Control\Keyboard Layout', True);
if boolState then
WriteBinaryData('Scancode Map', Data, SizeOf(Data))
else
DeleteValue('Scancode Map');
MessageDlg('Restart Windows in order the changes to take effect!',
mtInformation, [mbOK], 0);
CloseKey;
end;
finally
SystemReg.Free;
end;
except
MessageDlg
('Error occurred while trying to disable ctrl+alt+del and Task Manager',
mtWarning, [mbOK], 0);
end;
end;
begin
try
DisableCtrAltDel(True);
except
on E: Exception do
Writeln(E.ClassName, ': ', E.Message);
end;
end.
Reference
I am looking for a way to be able to retrieve IP Subnet mask of the computer I am currently
running on at run time, in Delphi.
Is there a way in code for me to retrieve the subnet mask and store it so that I may use it in other operations?
Thanks
You can use the Win32_NetworkAdapterConfiguration WMI class and the IPSubnet property.
Try this sample code
{$APPTYPE CONSOLE}
uses
SysUtils,
ActiveX,
ComObj,
Variants;
function VarArrayToStr(const vArray: variant): string;
function _VarToStr(const V: variant): string;
var
Vt: integer;
begin
Vt := VarType(V);
case Vt of
varSmallint,
varInteger : Result := IntToStr(integer(V));
varSingle,
varDouble,
varCurrency : Result := FloatToStr(Double(V));
varDate : Result := VarToStr(V);
varOleStr : Result := WideString(V);
varBoolean : Result := VarToStr(V);
varVariant : Result := VarToStr(Variant(V));
varByte : Result := char(byte(V));
varString : Result := String(V);
varArray : Result := VarArrayToStr(Variant(V));
end;
end;
var
i : integer;
begin
Result := '[';
if (VarType(vArray) and VarArray)=0 then
Result := _VarToStr(vArray)
else
for i := VarArrayLowBound(vArray, 1) to VarArrayHighBound(vArray, 1) do
if i=VarArrayLowBound(vArray, 1) then
Result := Result+_VarToStr(vArray[i])
else
Result := Result+'|'+_VarToStr(vArray[i]);
Result:=Result+']';
end;
procedure GetWin32_NetworkAdapterConfigurationInfo;
const
WbemUser ='';
WbemPassword ='';
WbemComputer ='localhost';
wbemFlagForwardOnly = $00000020;
var
FSWbemLocator : OLEVariant;
FWMIService : OLEVariant;
FWbemObjectSet: OLEVariant;
FWbemObject : OLEVariant;
oEnum : IEnumvariant;
iValue : LongWord;
begin;
FSWbemLocator := CreateOleObject('WbemScripting.SWbemLocator');
FWMIService := FSWbemLocator.ConnectServer(WbemComputer, 'root\CIMV2', WbemUser, WbemPassword);
FWbemObjectSet:= FWMIService.ExecQuery('SELECT * FROM Win32_NetworkAdapterConfiguration Where IpEnabled=True','WQL',wbemFlagForwardOnly);
oEnum := IUnknown(FWbemObjectSet._NewEnum) as IEnumVariant;
while oEnum.Next(1, FWbemObject, iValue) = 0 do
begin
Writeln(Format('Caption %s',[String(FWbemObject.Caption)]));// String
if not VarIsNull(FWbemObject.DHCPServer) then
Writeln(Format('DHCPServer %s',[String(FWbemObject.DHCPServer)]));// String
if not VarIsNull(FWbemObject.IPAddress) then
Writeln(Format('IPAddress %s',[VarArrayToStr(FWbemObject.IPAddress)]));// array String
if not VarIsNull(FWbemObject.IPSubnet) then
Writeln(Format('IPSubnet %s',[VarArrayToStr(FWbemObject.IPSubnet)]));// array String
if not VarIsNull(FWbemObject.MACAddress) then
Writeln(Format('MACAddress %s',[VarArrayToStr(FWbemObject.MACAddress)]));// array String
Writeln;
FWbemObject:=Unassigned;
end;
end;
begin
try
CoInitialize(nil);
try
GetWin32_NetworkAdapterConfigurationInfo;
finally
CoUninitialize;
end;
except
on E:EOleException do
Writeln(Format('EOleException %s %x', [E.Message,E.ErrorCode]));
on E:Exception do
Writeln(E.Classname, ':', E.Message);
end;
Writeln('Press Enter to exit');
Readln;
end.
1) computer may be opart of different Nets/Subnets. Each network adapter usually has some. OR even more than one sometimes.
2) Even if physically you only have one network card, ypou also have loopback network - 127.x.x.x subnet. If you have some VPN installed like Hamachi or Comodo - that would give one more network adapter. Same for phone modem when connected. Same for virtual machines like XP Compatibility Mode. So you anyway would have to filter them one some criteria.
3) You can enlist network cards with FindAdaptor function of WMI: http://www.magsys.co.uk/delphi/magwmi.asp
Then you can read the properties of those adaptors.
There are also mentioned functions to set IP's, probably there are also functiones to read them.
Even if not, how to read properties is shown in the demo at the URL.
Which properties to read, you can determine using any WMI explorer out there.
Personally i ended with WMI Explorer of ks-soft.net plus WMI Tools of Microsoft.
You debug WMI request like you would do with SQLite, then pass it to WMI wrapper and read the result.
However, returning back to aforementioned Set IP Address functions, their sources probably already do contain properties names, just to save on exploring.
I have been looking for ages now for some code that can translate any language to another but none of the code I find works.
I know Google has a good translate API but I can't get anyone's Delphi code on it to work.
There is always an error that comes in the way.
Any help would be much appreciated, I need a program that can translate ASAP of my final school project.
The Google Translate API is a good option, but now is available only as a paid service. Instead you can try the Microsoft Translator V2 API, check this article Using the Microsoft Translator V2 API from delphi for more details about how use this API from delphi.
UPDATE
This is the same demo project of the article modified to be compatible with your version of delphi.
program MicrosoftTranslatorApi;
{$APPTYPE CONSOLE}
uses
ShellApi,
ActiveX,
Classes,
ComObj,
Variants,
Windows,
WinInet,
SysUtils;
const
MicrosoftTranslatorTranslateUri = 'http://api.microsofttranslator.com/v2/Http.svc/Translate?appId=%s&text=%s&from=%s&to=%s';
MicrosoftTranslatorDetectUri = 'http://api.microsofttranslator.com/v2/Http.svc/Detect?appId=%s&text=%s';
MicrosoftTranslatorGetLngUri = 'http://api.microsofttranslator.com/v2/Http.svc/GetLanguagesForTranslate?appId=%s';
MicrosoftTranslatorGetSpkUri = 'http://api.microsofttranslator.com/v2/Http.svc/GetLanguagesForSpeak?appId=%s';
MicrosoftTranslatorSpeakUri = 'http://api.microsofttranslator.com/v2/Http.svc/Speak?appId=%s&text=%s&language=%s';
//this AppId if for demo only please be nice and use your own , it's easy get one from here http://msdn.microsoft.com/en-us/library/ff512386.aspx
BingAppId = '73C8F474CA4D1202AD60747126813B731199ECEA';
Msxml2_DOMDocument = 'Msxml2.DOMDocument.6.0';
procedure WinInet_HttpGet(const Url: string;Stream:TStream);overload;
const
BuffSize = 1024*1024;
var
hInter : HINTERNET;
UrlHandle: HINTERNET;
BytesRead: DWORD;
Buffer : Pointer;
begin
hInter := InternetOpen('', INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0);
if Assigned(hInter) then
try
Stream.Seek(0,0);
GetMem(Buffer,BuffSize);
try
UrlHandle := InternetOpenUrl(hInter, PChar(Url), nil, 0, INTERNET_FLAG_RELOAD, 0);
if Assigned(UrlHandle) then
begin
repeat
InternetReadFile(UrlHandle, Buffer, BuffSize, BytesRead);
if BytesRead>0 then
Stream.WriteBuffer(Buffer^,BytesRead);
until BytesRead = 0;
InternetCloseHandle(UrlHandle);
end;
finally
FreeMem(Buffer);
end;
finally
InternetCloseHandle(hInter);
end;
end;
function WinInet_HttpGet(const Url: string): string;overload;
Var
StringStream : TStringStream;
begin
Result:='';
StringStream:=TStringStream.Create('');
try
WinInet_HttpGet(Url,StringStream);
if StringStream.Size>0 then
begin
StringStream.Seek(0,0);
Result:=StringStream.ReadString(StringStream.Size);
end;
finally
StringStream.Free;
end;
end;
function TranslateText(const AText,SourceLng,DestLng:string):string;
var
XmlDoc : OleVariant;
Node : OleVariant;
begin
Result:=WinInet_HttpGet(Format(MicrosoftTranslatorTranslateUri,[BingAppId,AText,SourceLng,DestLng]));
XmlDoc:= CreateOleObject(Msxml2_DOMDocument);
try
XmlDoc.Async := False;
XmlDoc.LoadXML(Result);
if (XmlDoc.parseError.errorCode <> 0) then
raise Exception.CreateFmt('Error in Xml Data %s',[XmlDoc.parseError]);
Node:= XmlDoc.documentElement;
if not VarIsClear(Node) then
Result:=XmlDoc.Text;
finally
XmlDoc:=Unassigned;
end;
end;
function DetectLanguage(const AText:string ):string;
var
XmlDoc : OleVariant;
Node : OleVariant;
begin
Result:=WinInet_HttpGet(Format(MicrosoftTranslatorDetectUri,[BingAppId,AText]));
XmlDoc:= CreateOleObject(Msxml2_DOMDocument);
try
XmlDoc.Async := False;
XmlDoc.LoadXML(Result);
if (XmlDoc.parseError.errorCode <> 0) then
raise Exception.CreateFmt('Error in Xml Data %s',[XmlDoc.parseError]);
Node:= XmlDoc.documentElement;
if not VarIsClear(Node) then
Result:=XmlDoc.Text;
finally
XmlDoc:=Unassigned;
end;
end;
function GetLanguagesForTranslate: TStringList;
var
XmlDoc : OleVariant;
Node : OleVariant;
Nodes : OleVariant;
lNodes : Integer;
i : Integer;
sValue : string;
begin
Result:=TStringList.Create;
sValue:=WinInet_HttpGet(Format(MicrosoftTranslatorGetLngUri,[BingAppId]));
XmlDoc:= CreateOleObject(Msxml2_DOMDocument);
try
XmlDoc.Async := False;
XmlDoc.LoadXML(sValue);
if (XmlDoc.parseError.errorCode <> 0) then
raise Exception.CreateFmt('Error in Xml Data %s',[XmlDoc.parseError]);
Node:= XmlDoc.documentElement;
if not VarIsClear(Node) then
begin
Nodes := Node.childNodes;
if not VarIsClear(Nodes) then
begin
lNodes:= Nodes.Length;
for i:=0 to lNodes-1 do
Result.Add(Nodes.Item(i).Text);
end;
end;
finally
XmlDoc:=Unassigned;
end;
end;
function GetLanguagesForSpeak: TStringList;
var
XmlDoc : OleVariant;
Node : OleVariant;
Nodes : OleVariant;
lNodes : Integer;
i : Integer;
sValue : string;
begin
Result:=TStringList.Create;
sValue:=WinInet_HttpGet(Format(MicrosoftTranslatorGetSpkUri,[BingAppId]));
XmlDoc:= CreateOleObject(Msxml2_DOMDocument);
try
XmlDoc.Async := False;
XmlDoc.LoadXML(sValue);
if (XmlDoc.parseError.errorCode <> 0) then
raise Exception.CreateFmt('Error in Xml Data %s',[XmlDoc.parseError]);
Node:= XmlDoc.documentElement;
if not VarIsClear(Node) then
begin
Nodes := Node.childNodes;
if not VarIsClear(Nodes) then
begin
lNodes:= Nodes.Length;
for i:=0 to lNodes-1 do
Result.Add(Nodes.Item(i).Text);
end;
end;
finally
XmlDoc:=Unassigned;
end;
end;
procedure Speak(const FileName,AText,Lng:string);
var
Stream : TFileStream;
begin
Stream:=TFileStream.Create(FileName,fmCreate);
try
WinInet_HttpGet(Format(MicrosoftTranslatorSpeakUri,[BingAppId,AText,Lng]),Stream);
finally
Stream.Free;
end;
end;
var
lng : TStringList;
i : Integer;
FileName : string;
begin
try
CoInitialize(nil);
try
Writeln(TranslateText('Hello World','en','es'));
Writeln(DetectLanguage('Hello World'));
Writeln('Languages for translate supported');
lng:=GetLanguagesForTranslate;
try
for i:=0 to lng.Count-1 do
Writeln(lng[i]);
finally
lng.free;
end;
Writeln('Languages for speak supported');
lng:=GetLanguagesForSpeak;
try
for i:=0 to lng.Count-1 do
Writeln(lng[i]);
finally
lng.free;
end;
FileName:=ExtractFilePath(ParamStr(0))+'Demo.wav';
Speak(FileName,'This is a demo using the Microsoft Translator Api from delphi, enjoy','en');
ShellExecute(0, 'open', PChar(FileName),nil,nil, SW_SHOWNORMAL) ;
finally
CoUninitialize;
end;
except
on E:Exception do
Writeln(E.Classname, ':', E.Message);
end;
Writeln('Press Enter to exit');
Readln;
end.
Maybe you did not find Marco Cantu's works?Works with REST/AJAX/Delphi
But as RRUZ said, the Google Translate API is only available now as a paid service.
First of all, you can not find a 100% tool to translate from a language to another. You can have a tool which is doing some(more or less) of the job for you, but you need to 'polish' the rest. As RRUZ said, you can use the Microsoft's translator but what I've said applies also in this case. Any tool of this type will cost you money. Google's translate is quite good, but you need to pay for it.
PS: I don't think that at school they ask you to create a tool which is translating from any language to any language. Maybe a small tool which can prove you got the concept. just my 2 cents...
In my application (Delphi), I need to list all the USB storage devices. These can be either flash memory sticks or external storage drives.
There is a Jvcl component JvDriveCombo, and it has the DriveType property - the problem is if I select DriveType := Fixed then in addition to the external drive, it also lists the internal drives (C:\, D:\ etc). However, I only want to list the external drives.
I believe there is DeviceIoControl function (I saw it on MSDN) but I have no idea of how to use it.
I wonder if anyone can help me with the proper way / code to list USB storage devices?
Thanks.
EDIT:
I just found some sample code and am posting it here:
uses .... jwawinbase, JwaWinIoctl;
procedure TForm1.Button1Click(Sender: TObject);
var
DriveCmdStr: string;
DriveHandle: THandle;
ADriveLetter: string;
hp: STORAGE_HOTPLUG_INFO;
rlen: DWORD;
begin
ADriveLetter := 'H';
DriveCmdStr := Format('\\.\%s:', [ADriveLetter]);
DriveHandle := CreateFile(PChar(DriveCmdStr), GENERIC_READ, FILE_SHARE_WRITE,
nil, OPEN_EXISTING, 0, 0);
if DriveHandle = INVALID_HANDLE_VALUE then
Exit;
DeviceIoControl(DriveHandle, IOCTL_STORAGE_GET_HOTPLUG_INFO, nil, 0, #hp,
SizeOf(hp), #rlen, nil);
CloseHandle(DriveHandle);
if hp.MediaRemovable then
showmessage('media removable');
end;
Now I would like to just know how to enumerate all the drive letters. Which is the most efficient function?
{$MINENUMSIZE 4}
const
IOCTL_STORAGE_QUERY_PROPERTY = $002D1400;
type
STORAGE_QUERY_TYPE = (PropertyStandardQuery = 0, PropertyExistsQuery, PropertyMaskQuery, PropertyQueryMaxDefined);
TStorageQueryType = STORAGE_QUERY_TYPE;
STORAGE_PROPERTY_ID = (StorageDeviceProperty = 0, StorageAdapterProperty);
TStoragePropertyID = STORAGE_PROPERTY_ID;
STORAGE_PROPERTY_QUERY = packed record
PropertyId: STORAGE_PROPERTY_ID;
QueryType: STORAGE_QUERY_TYPE;
AdditionalParameters: array [0..9] of AnsiChar;
end;
TStoragePropertyQuery = STORAGE_PROPERTY_QUERY;
STORAGE_BUS_TYPE = (BusTypeUnknown = 0, BusTypeScsi, BusTypeAtapi, BusTypeAta, BusType1394, BusTypeSsa, BusTypeFibre,
BusTypeUsb, BusTypeRAID, BusTypeiScsi, BusTypeSas, BusTypeSata, BusTypeMaxReserved = $7F);
TStorageBusType = STORAGE_BUS_TYPE;
STORAGE_DEVICE_DESCRIPTOR = packed record
Version: DWORD;
Size: DWORD;
DeviceType: Byte;
DeviceTypeModifier: Byte;
RemovableMedia: Boolean;
CommandQueueing: Boolean;
VendorIdOffset: DWORD;
ProductIdOffset: DWORD;
ProductRevisionOffset: DWORD;
SerialNumberOffset: DWORD;
BusType: STORAGE_BUS_TYPE;
RawPropertiesLength: DWORD;
RawDeviceProperties: array [0..0] of AnsiChar;
end;
TStorageDeviceDescriptor = STORAGE_DEVICE_DESCRIPTOR;
function GetBusType(Drive: AnsiChar): TStorageBusType;
var
H: THandle;
Query: TStoragePropertyQuery;
dwBytesReturned: DWORD;
Buffer: array [0..1023] of Byte;
sdd: TStorageDeviceDescriptor absolute Buffer;
OldMode: UINT;
begin
Result := BusTypeUnknown;
OldMode := SetErrorMode(SEM_FAILCRITICALERRORS);
try
H := CreateFile(PChar(Format('\\.\%s:', [AnsiLowerCase(Drive)])), 0, FILE_SHARE_READ or FILE_SHARE_WRITE, nil,
OPEN_EXISTING, 0, 0);
if H <> INVALID_HANDLE_VALUE then
begin
try
dwBytesReturned := 0;
FillChar(Query, SizeOf(Query), 0);
FillChar(Buffer, SizeOf(Buffer), 0);
sdd.Size := SizeOf(Buffer);
Query.PropertyId := StorageDeviceProperty;
Query.QueryType := PropertyStandardQuery;
if DeviceIoControl(H, IOCTL_STORAGE_QUERY_PROPERTY, #Query, SizeOf(Query), #Buffer, SizeOf(Buffer), dwBytesReturned, nil) then
Result := sdd.BusType;
finally
CloseHandle(H);
end;
end;
finally
SetErrorMode(OldMode);
end;
end;
procedure GetUsbDrives(List: TStrings);
var
DriveBits: set of 0..25;
I: Integer;
Drive: AnsiChar;
begin
List.BeginUpdate;
try
Cardinal(DriveBits) := GetLogicalDrives;
for I := 0 to 25 do
if I in DriveBits then
begin
Drive := Chr(Ord('a') + I);
if GetBusType(Drive) = BusTypeUsb then
List.Add(Drive);
end;
finally
List.EndUpdate;
end;
end;
You can access this information using WMI. If you use this SQL you can access information about installed disks.
select * from Win32_diskdrive where size<>NULL
This code retrive information about drives.
procedure TForm1.DoInventario(aWSQL:string; var mmResult:TMemo);
var
Locator:ISWbemLocator;
Services:ISWbemServices;
SObject:ISWbemObject;
ObjSet:ISWbemObjectSet;
Enum:IEnumVariant;
TempObj:OleVariant;
Value:Cardinal;
TS:TStrings;
begin
try
Locator := CoSWbemLocator.Create();
// Conectar con el Servicio de WMI
Services := Locator.ConnectServer(
STR_LOCALHOST, {ordenador local}
STR_CIM2_ROOT, {root}
STR_EMPTY, STR_EMPTY, {usuario y password -en local no son necesarios-}
STR_EMPTY,STR_EMPTY, 0, nil);
// Acceder a los datos
ObjSet := Services.ExecQuery(aWSQL, 'WQL',
wbemFlagReturnImmediately and wbemFlagForwardOnly , nil);
Enum := (ObjSet._NewEnum) as IEnumVariant;
// Hemos encontrado algun objeto?
while (Enum.Next(1, TempObj, Value) = S_OK) do begin
SObject := IUnknown(TempObj) as ISWBemObject;
// encontrado?
if (SObject <> nil) then begin
// Acceder a la propiedad
SObject.Properties_;
// Cargamos las propiedades
TS := TStringList.Create();
try
TS.Add(SObject.GetObjectText_(0));
// lo pasamos al memo
mmResult.Lines.Text := mmResult.Lines.Text + TS.Text;
finally
FreeAndNil(TS);
end;
end;
end;
except
// Recuperar excepciones
end;
end;
You must add ActiveX and WbemScripting_TLB (this must be imported) in your uses.
With this you can access all information of the disks.
To retrive the letter of all disk you can combine (retrieve can do with the same code) the access to the classes Win32_LogicalDiskToPartition and Win32_DiskDrive.
select * from Win32_LogicalDiskToPartition
select * from Win32_DiskDrive
If you search WMI you can find more related codes.
Regards.
I'm not sure if you're just looking to enumerate drive letters? The for-loop below does that, going through all letters, regardless of whether there's a drive for that letter.
Or, if you're looking for a different way to find removable drives, there's a function for that below, too. (Yours may be better...) Surprisingly, on my test, Windows.GetDriveType does NOT consider CD drives as removable. USB drives are flagged as removable, as one would expect.
Function RemovableDrive(Drive: char): Boolean;
begin
Result := (Windows.GetDriveType(PChar(Drive + ':\')) = Windows.Drive_Removable);
end;
procedure TForm1.Button1Click(Sender: TObject);
var
Drive: Char;
begin
for Drive := 'A' to 'Z' do
Memo1.Lines.Add('Drive: ' + Drive + ' is ' + BoolToStr(RemovableDrive(Drive), TRUE));
end;
How can I get the list of opened files by an application, using Delphi?
For example what files are opened by winword.exe
Using the Native API function NtQuerySystemInformation you can list all open handles from all processes.
try this example
program ListAllHandles;
{$APPTYPE CONSOLE}
uses
PSApi,
Windows,
SysUtils;
const
SystemHandleInformation = $10;
STATUS_SUCCESS = $00000000;
STATUS_BUFFER_OVERFLOW = $80000005;
STATUS_INFO_LENGTH_MISMATCH = $C0000004;
DefaulBUFFERSIZE = $100000;
type
OBJECT_INFORMATION_CLASS = (ObjectBasicInformation,ObjectNameInformation,ObjectTypeInformation,ObjectAllTypesInformation,ObjectHandleInformation );
SYSTEM_HANDLE=packed record
uIdProcess:ULONG;
ObjectType:UCHAR;
Flags :UCHAR;
Handle :Word;
pObject :Pointer;
GrantedAccess:ACCESS_MASK;
end;
PSYSTEM_HANDLE = ^SYSTEM_HANDLE;
SYSTEM_HANDLE_ARRAY = Array[0..0] of SYSTEM_HANDLE;
PSYSTEM_HANDLE_ARRAY= ^SYSTEM_HANDLE_ARRAY;
SYSTEM_HANDLE_INFORMATION=packed record
uCount:ULONG;
Handles:SYSTEM_HANDLE_ARRAY;
end;
PSYSTEM_HANDLE_INFORMATION=^SYSTEM_HANDLE_INFORMATION;
TNtQuerySystemInformation=function (SystemInformationClass:DWORD; SystemInformation:pointer; SystemInformationLength:DWORD; ReturnLength:PDWORD):THandle; stdcall;
TNtQueryObject =function (ObjectHandle:cardinal; ObjectInformationClass:OBJECT_INFORMATION_CLASS; ObjectInformation:pointer; Length:ULONG;ResultLength:PDWORD):THandle;stdcall;
UNICODE_STRING=packed record
Length :Word;
MaximumLength:Word;
Buffer :PWideChar;
end;
OBJECT_NAME_INFORMATION=UNICODE_STRING;
POBJECT_NAME_INFORMATION=^OBJECT_NAME_INFORMATION;
Var
NTQueryObject :TNtQueryObject;
NTQuerySystemInformation:TNTQuerySystemInformation;
function GetObjectInfo(hObject:cardinal; objInfoClass:OBJECT_INFORMATION_CLASS):LPWSTR;
var
pObjectInfo:POBJECT_NAME_INFORMATION;
HDummy :THandle;
dwSize :DWORD;
begin
Result:=nil;
dwSize := sizeof(OBJECT_NAME_INFORMATION);
pObjectInfo := AllocMem(dwSize);
HDummy := NTQueryObject(hObject, objInfoClass, pObjectInfo,dwSize, #dwSize);
if((HDummy = STATUS_BUFFER_OVERFLOW) or (HDummy = STATUS_INFO_LENGTH_MISMATCH)) then
begin
FreeMem(pObjectInfo);
pObjectInfo := AllocMem(dwSize);
HDummy := NTQueryObject(hObject, objInfoClass, pObjectInfo,dwSize, #dwSize);
end;
if((HDummy >= STATUS_SUCCESS) and (pObjectInfo.Buffer <> nil)) then
begin
Result := AllocMem(pObjectInfo.Length + sizeof(WCHAR));
CopyMemory(result, pObjectInfo.Buffer, pObjectInfo.Length);
end;
FreeMem(pObjectInfo);
end;
Procedure EnumerateOpenFiles();
var
sDummy : string;
hProcess : THandle;
hObject : THandle;
ResultLength: DWORD;
aBufferSize : DWORD;
aIndex : Integer;
pHandleInfo : PSYSTEM_HANDLE_INFORMATION;
HDummy : THandle;
lpwsName : PWideChar;
lpwsType : PWideChar;
lpszProcess : PAnsiChar;
begin
AbufferSize := DefaulBUFFERSIZE;
pHandleInfo := AllocMem(AbufferSize);
HDummy := NTQuerySystemInformation(DWORD(SystemHandleInformation), pHandleInfo,AbufferSize, #ResultLength); //Get the list of handles
if(HDummy = STATUS_SUCCESS) then //If no error continue
begin
for aIndex:=0 to pHandleInfo^.uCount-1 do //iterate the list
begin
hProcess := OpenProcess(PROCESS_DUP_HANDLE or PROCESS_QUERY_INFORMATION or PROCESS_VM_READ, FALSE, pHandleInfo.Handles[aIndex].uIdProcess); //open the process to get aditional info
if(hProcess <> INVALID_HANDLE_VALUE) then //Check valid handle
begin
hObject := 0;
if DuplicateHandle(hProcess, pHandleInfo.Handles[aIndex].Handle,GetCurrentProcess(), #hObject, STANDARD_RIGHTS_REQUIRED,FALSE, 0) then //Get a copy of the original handle
begin
lpwsName := GetObjectInfo(hObject, ObjectNameInformation); //Get the filename linked to the handle
if (lpwsName <> nil) then
begin
lpwsType := GetObjectInfo(hObject, ObjectTypeInformation);
lpszProcess := AllocMem(MAX_PATH);
if GetModuleFileNameEx(hProcess, 0,lpszProcess, MAX_PATH)<>0 then //get the name of the process
sDummy:=ExtractFileName(lpszProcess)
else
sDummy:= 'System Process';
Writeln('PID ',pHandleInfo.Handles[aIndex].uIdProcess);
Writeln('Handle ',pHandleInfo.Handles[aIndex].Handle);
Writeln('Process ',sDummy);
Writeln('FileName ',string(lpwsName));
Writeln;
FreeMem(lpwsName);
FreeMem(lpwsType);
FreeMem(lpszProcess);
end;
CloseHandle(hObject);
end;
CloseHandle(hProcess);
end;
end;
end;
FreeMem(pHandleInfo);
end;
begin
try
NTQueryObject := GetProcAddress(GetModuleHandle('NTDLL.DLL'), 'NtQueryObject');
NTQuerySystemInformation := GetProcAddress(GetModuleHandle('NTDLL.DLL'), 'NtQuerySystemInformation');
if (#NTQuerySystemInformation<>nil) and (#NTQuerySystemInformation<>nil) then
EnumerateOpenFiles();
Readln;
except
on E:Exception do
Writeln(E.Classname, ': ', E.Message);
end;
end.
You could port walkobjects.cpp or run a command line process that does it for you and parse it's output.
I've looked at the MSDN page...
it said NtQuerySystemInformation() is an OS internal proc,
and that we're not recommended to use it:
The NtQuerySystemInformation function
and the structures that it returns are
internal to the operating system and
subject to change from one release of
Windows to another. To maintain the
compatibility of your application, it
is better to use the alternate
functions previously mentioned
instead.