I'm having a hard time converting Chinese words to English automatically. Where did I go wrong?
If I convert Filipino words to English everything is OK, but not with Chinese words. It will still result a string but not readable chinese word.
procedure TForm1.btn2Click(Sender: TObject);
var
sTemp : AnsiString;
begin
try
// filipino to english SUCCESS
sTemp := TranslateText('maganda', 'fil', ' en');
memo2.Lines.Add(sTemp);
// chinese to english FAILED
sTemp := TranslateText('美丽', 'zh', ' en');
memo2.Lines.Add(sTemp);
except
on E:Exception do
begin
ShowMessage(E.Message);
end;
end;
end;
function TranslateText(const AText, SourceLng, DestLng : AnsiString) : AnsiString;
var
XmlDoc : OleVariant;
Node : OleVariant;
begin
Result:=WinInet_HttpGet(Format('http://api.microsofttranslator.com/v2/Http.svc/Translate?appId=%s&text=%s&from=%s&to=%s',['73C8F474CA4D1202AD60747126813B731199ECEA',AText,SourceLng,DestLng]));
XmlDoc:= CreateOleObject('Msxml2.DOMDocument.6.0');
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;
Related
(First, I am not sure whether this question is placed in the correct section of Stack Exchange. If not so, please give me a notice and delete the question.)
I have 8 Arduino's (Ards). Some Uno's and some 2650 Mega's. In an attempt to automatize the connection process (I use Delphi D-7 SE as I/O), I want to differentate between the UNO and the 2650 (mostly because the hardware differences in the appropriate chip). The way to do this (I think), is to get the PID and VID from the board. But I don't know how to do this. The code below gives me the correct driver, but not PID/VID . Is it possible to get PID/VID for this code-snippet ?? IF so, HOW ?
Thanks a lot.
Code here:
unit ArduinoTestU;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics,
Controls, Forms, Dialogs, JVsetupAPI, Registry, StdCtrls,
CPortCtl, CPort, Menus, XPMan;
type
TMainForm = class(TForm)
ListBox1: TListBox;
Label1: TLabel;
Button1: TButton;
procedure FormCreate(Sender: TObject);
function SetupEnumAvailableComPorts : TstringList;
procedure ListBox1Click(Sender: TObject);
procedure FormActivate(Sender: TObject);
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
ArdType : Integer;
end;
var
MainForm : TMainForm;
ComPortStringList : TStringList;
MyComPort : String;
CurDir : String;
implementation
uses Form1Unit, ArdFormU; (* , ArdFormU; *)
{$R *.dfm}
procedure TMainForm.Button1Click(Sender: TObject);
begin
MainForm.FormActivate(NIL);
end;
procedure TMainForm.FormActivate(Sender: TObject);
var
index : integer;
begin
ComPortStringList := SetupEnumAvailableComPorts;
if (ComPortStringList <> nil) and (ComPortStringList.Count > 0) then
for Index := 0 to ComPortStringList.Count - 1 do
Listbox1.Items.Add(ComPortStringList[Index]);
if Listbox1.Items.Count <> 0 then
BEGIN
Listbox1.Enabled := True;
Button1.Enabled := False;
END;
end;
procedure TMainForm.FormCreate(Sender: TObject);
BEGIN
Curdir := ExtractFileDir(Application.Exename);
end;
(*
The function below returns a list of available COM-ports
(not open by this or an other process), with friendly names. The list is formatted as follows:
COM1: = Communications Port (COM1)
COM5: = NI Serial Port (Com5)
COM6: = NI Serial Port (Com6)
COM7: = USB Serial Port (COM7)
COM8: = Bluetooth Communications Port (COM8)
COM9: = Bluetooth Communications Port (COM9)
This code originally posted at http://www.delphi3000.com/articles/article_4001.asp?SK=
errors have been fixed so it will work with Delphi 7 and SetupAPI from JVCL
*)
function TMainForm.SetupEnumAvailableComPorts : TstringList;
//
// Enumerates all serial communications ports that are available and ready to
// be used.
//
var
RequiredSize: Cardinal;
GUIDSize: DWORD;
Guid: TGUID;
DevInfoHandle: HDEVINFO;
DeviceInfoData: TSPDevInfoData;
MemberIndex: Cardinal;
PropertyRegDataType: DWord;
RegProperty: Cardinal;
RegTyp: Cardinal;
Key: Hkey;
Info: TRegKeyInfo;
S1,S2: string;
hc: THandle;
begin
Result := Nil;
//
//If we cannot access the setupapi.dll then we return a nil pointer.
//
if not LoadsetupAPI then
exit;
try
//
// get 'Ports' class guid from name
//
GUIDSize := 1; // missing from original code - need to tell function that the Guid structure contains a single GUID
if SetupDiClassGuidsFromName('Ports',#Guid,GUIDSize,RequiredSize) then
begin
//
//get object handle of 'Ports' class to interate all devices
//
DevInfoHandle := SetupDiGetClassDevs(#Guid,Nil,0,DIGCF_PRESENT);
if Cardinal(DevInfoHandle) <> Invalid_Handle_Value then
begin
try
MemberIndex := 0;
result := TStringList.Create;
//iterate device list
repeat
FillChar(DeviceInfoData,SizeOf(DeviceInfoData),0);
DeviceInfoData.cbSize := SizeOf(DeviceInfoData);
//get device info that corresponds to the next memberindex
if Not SetupDiEnumDeviceInfo(DevInfoHandle,MemberIndex,DeviceInfoData) then
break;
//query friendly device name LIKE 'BlueTooth Communication Port (COM8)' etc
RegProperty := SPDRP_FriendlyName; {SPDRP_Driver, SPDRP_SERVICE, SPDRP_ENUMERATOR_NAME,SPDRP_PHYSICAL_DEVICE_OBJECT_NAME,SPDRP_FRIENDLYNAME,}
SetupDiGetDeviceRegistryProperty(DevInfoHandle, DeviceInfoData,RegProperty, PropertyRegDataType,NIL,0,RequiredSize);
SetLength(S1,RequiredSize);
// ShowMessage('TEST: ' + S1);
if SetupDiGetDeviceRegistryProperty(DevInfoHandle,DeviceInfoData,RegProperty,PropertyRegDataType,#S1[1],RequiredSize,RequiredSize) then
begin
KEY := SetupDiOpenDevRegKey(DevInfoHandle,DeviceInfoData,DICS_FLAG_GLOBAL,0,DIREG_DEV,KEY_READ);
if key <> INValid_Handle_Value then
begin
FillChar(Info, SizeOf(Info), 0);
//query the real port name from the registry value 'PortName'
if RegQueryInfoKey(Key, nil, nil, nil, #Info.NumSubKeys,#Info.MaxSubKeyLen, nil, #Info.NumValues, #Info.MaxValueLen,
#Info.MaxDataLen, nil, #Info.FileTime) = ERROR_SUCCESS then
begin
RequiredSize := Info.MaxValueLen + 1;
SetLength(S2,RequiredSize);
if RegQueryValueEx(KEY,'PortName',Nil,#Regtyp,#s2[1],#RequiredSize) = Error_Success then
begin
If (Pos('COM',S2) = 1) then
begin
//Test if the device can be used
hc := CreateFile(pchar('\\.\' + S2 + #0), GENERIC_READ or GENERIC_WRITE,
0, nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0);
if hc <> INVALID_HANDLE_VALUE then
begin
Result.Add(Strpas(PChar(S2)) + ' := ' + StrPas(PChar(S1)));
CloseHandle(hc);
end;
end;
end;
end;
RegCloseKey(key);
end;
end;
Inc(MemberIndex);
until False;
//If we did not found any free com. port we return a NIL pointer.
if Result.Count = 0 then
begin
Result.Free;
Result := NIL;
end
finally
SetupDiDestroyDeviceInfoList(DevInfoHandle);
end;
end;
end;
finally
UnloadSetupApi;
end;
end;
procedure TMainForm.ListBox1Click(Sender: TObject);
begin
Ardtype := Listbox1.ItemIndex;
MainForm.Hide;
ArdForm.ShowModal;
if Ardform.ModalResult <> mrOK then
ShowMessage('Der opstod en fejl ')
ELSE
BEGIN
MainForm.Show;
END;
end;
end.
Kris aka snestrup2016
I'm starting to use Inno Setup, and I have some problems with my INI file encoding.
I want to save user input in the INI file, and this input can contain accents.
I use Inno Setup Unicode, my setupScript.iss is UTF-8 encoded, and here is my code (a part) :
[INI]
Filename: "{app}\www\conf\config.ini"; Section: "Settings"; Key: "ca.plafondAnnuel"; String: "{code:GetUser|Plafond}"
Filename: "{app}\www\conf\config.ini"; Section: "Settings"; Key: "app.siren"; String: "{code:GetUser|Siren}"
Filename: "{app}\www\conf\config.ini"; Section: "Settings"; Key: "app.adresse"; String: "{code:GetUser|Adresse}"
[Code]
var
UserPage: TInputQueryWizardPage;
ExamplePage : TInputOptionWizardPage;
ImmatriculationPage : TInputOptionWizardPage;
FakeElemIndex: Integer;
FakeElem: TCustomEdit;
AdresseTextarea: TNewMemo;
procedure InitializeWizard;
begin
UserPage := CreateInputQueryPage(wpWelcome,
'Configuration de l''application', '',
'Configurez ici votre application. Une fois installée, vous pourrez modifier ces valeurs.');
UserPage.Add('Siren :', False);
UserPage.Add('Plafond annuel (utilisé par les auto-entreprises, mettre 0 si vous ne souhaitez pas plafonner votre chiffre d''affaire.):', False);
FakeElemIndex := UserPage.Add('Votre adresse complète (telle qu''elle s''affichera sur les devis et factures, avec nom complet):', False);
FakeElem := UserPage.Edits[FakeElemIndex];
AdresseTextarea := TNewMemo.Create(WizardForm);
AdresseTextarea.Parent := FakeElem.Parent;
AdresseTextarea.SetBounds(FakeElem.Left, FakeElem.Top, FakeElem.Width, ScaleY(50));
// Hide the original single-line edit
FakeElem.Visible := False;
end;
function GetUser(Param: String): String;
begin
if Param = 'Adresse' then
Result := AdresseTextarea.Text
else if Param = 'Siren' then
Result := UserPage.Values[0]
else if Param = 'Plafond' then
Result := UserPage.Values[1];
end;
The value returned by getUser|Adresse in the [INI] part is not UTF-8 encoded: I open the INI file with Notepad++ and I see the file is UTF-8 encoded. But the value adresse is ANSI encoded (If I change the encoding of the file to ANSI, this value is readable)
Someone can help me understand how can I save this user input in UTF-8 ?
Thanks a lot !
The INI functions of Inno Setup ([INI] section and SetIni* functions) use internally the Windows API function WritePrivateProfileString.
This function does not support UTF-8 at all. All it supports is the ANSI encoding and UTF-16.
See How to read/write Chinese/Japanese characters from/to INI files?
So it's even questionable whether the target application will be able to read UTF-8-encoded INI file, if it relies on the Windows API function to read it.
Anyway, if you need the UTF-8, you would have to format the entries to INI format yourself and use SaveStringsToUTF8File function to write it.
The last option is to hack it by using the system call WritePrivateProfileString to write seemingly ANSI-encoded string, which will be in fact UTF-8-encoded.
For that you need to convert the string to UTF-8 in your code. You can use WideCharToMultiByte for that.
function WideCharToMultiByte(CodePage: UINT; dwFlags: DWORD;
lpWideCharStr: string; cchWideChar: Integer; lpMultiByteStr: AnsiString;
cchMultiByte: Integer; lpDefaultCharFake: Integer;
lpUsedDefaultCharFake: Integer): Integer;
external 'WideCharToMultiByte#kernel32.dll stdcall';
const
CP_UTF8 = 65001;
function GetStringAsUtf8(S: string): AnsiString;
var
Len: Integer;
begin
Len := WideCharToMultiByte(CP_UTF8, 0, S, Length(S), Result, 0, 0, 0);
SetLength(Result, Len);
WideCharToMultiByte(CP_UTF8, 0, S, Length(S), Result, Len, 0, 0);
end;
function WritePrivateProfileString(
lpAppName, lpKeyName, lpString, lpFileName: AnsiString): Integer;
external 'WritePrivateProfileStringA#kernel32.dll stdcall';
procedure CurStepChanged(CurStep: TSetupStep);
var
IniFileName: string;
begin
if CurStep = ssInstall then
begin
Log('Writting INI file');
if not ForceDirectories(ExpandConstant('{app}\www\conf')) then
begin
MsgBox('Error creating directory for INI file', mbError, MB_OK);
end
else
begin
IniFileName := ExpandConstant('{app}\www\conf\config.ini');
if (WritePrivateProfileString(
'Settings', 'ca.plafondAnnuel', GetStringAsUtf8(GetUser('Plafond')),
IniFileName) = 0) or
(WritePrivateProfileString(
'Settings', 'app.siren', GetStringAsUtf8(GetUser('Siren')),
IniFileName) = 0) or
(WritePrivateProfileString(
'Settings', 'app.adresse', GetStringAsUtf8(GetUser('Adresse')),
IniFileName) = 0) then
begin
MsgBox('Error writting the INI file', mbError, MB_OK);
end;
end;
end;
end;
I want to enumerate all the file in the C:\Windows\Fonts\
First I use FindFirst&FindNext to get all the file
Code:
Path := 'C:\Windows\Fonts';
if FindFirst(Path + '\*', faNormal, FileRec) = 0 then
repeat
Memo1.Lines.Add(FileRec.Name);
until FindNext(FileRec) <> 0;
FindClose(FileRec);
it get some name like this tahoma.ttf which display Tahoma regular in windows font folder .
but how can I get that ?
second I why can't enumerate files in C:\Windows\Fonts\ by shell
Code :
var
psfDeskTop : IShellFolder;
psfFont : IShellFolder;
pidFont : PITEMIDLIST;
pidChild : PITEMIDLIST;
pidAbsolute : PItemIdList;
FileInfo : SHFILEINFOW;
pEnumList : IEnumIDList;
celtFetched : ULONG;
begin
OleCheck(SHGetDesktopFolder(psfDeskTop));
//Font folder path
OleCheck(SHGetSpecialFolderLocation(0, CSIDL_FONTS, pidFont));
OleCheck(psfDeskTop.BindToObject(pidFont, nil, IID_IShellFolder, psfFont));
OleCheck(psfFont.EnumObjects(0, SHCONTF_NONFOLDERS or SHCONTF_INCLUDEHIDDEN
or SHCONTF_FOLDERS, pEnumList));
while pEnumList.Next(0, pidChild, celtFetched ) = 0 do
begin
//break in here
pidAbsolute := ILCombine(pidFont, pidChild);
SHGetFileInfo(LPCTSTR(pidAbsolute), 0, FileInfo, SizeOf(FileInfo),
SHGFI_PIDL or SHGFI_DISPLAYNAME );
Memo1.Lines.Add(FileInfo.szDisplayName);
end;
end;
and I know use Screen.Fonts can get font list but it display different from C:\Windows\Fonts\;
The GetFontResourceInfo undocumented function can get the name of the font from a font file.
Try this sample
{$APPTYPE CONSOLE}
{$R *.res}
uses
Windows,
SysUtils;
function GetFontResourceInfo(lpszFilename: PChar; var cbBuffer: DWORD; lpBuffer: PChar; dwQueryType: DWORD): DWORD; stdcall; external 'gdi32.dll' name 'GetFontResourceInfoW';
procedure ListFonts;
const
QFR_DESCRIPTION =1;
var
FileRec : TSearchRec;
cbBuffer : DWORD;
lpBuffer: array[0..MAX_PATH-1] of Char;
begin
if FindFirst('C:\Windows\Fonts\*.*', faNormal, FileRec) = 0 then
try
repeat
cbBuffer:=SizeOf(lpBuffer);
GetFontResourceInfo(PWideChar('C:\Windows\Fonts\'+FileRec.Name), cbBuffer, lpBuffer, QFR_DESCRIPTION);
Writeln(Format('%s - %s',[FileRec.Name ,lpBuffer]));
until FindNext(FileRec) <> 0;
finally
FindClose(FileRec);
end;
end;
begin
try
ListFonts;
except
on E: Exception do
Writeln(E.ClassName, ': ', E.Message);
end;
Readln;
end.
About your second question
replace this line
while pEnumList.Next(0, pidChild, b) = 0 do
with
while pEnumList.Next(0, pidChild, celtFetched) = 0 do
I got this from a German Delphi forum. It works on Delphi 7 Enterprise.
function GetFontNameFromFile(FontFile: WideString): string;
type
TGetFontResourceInfoW = function(Name: PWideChar; var BufSize: Cardinal;
Buffer: Pointer; InfoType: Cardinal): LongBool; stdcall;
var
GFRI: TGetFontResourceInfoW;
AddFontRes, I: Integer;
LogFont: array of TLogFontW;
lfsz: Cardinal;
hFnt: HFONT;
begin
GFRI := GetProcAddress(GetModuleHandle('gdi32.dll'), 'GetFontResourceInfoW');
if #GFRI = nil then
raise Exception.Create('GetFontResourceInfoW in gdi32.dll not found.');
if LowerCase(ExtractFileExt(FontFile)) = '.pfm' then
FontFile := FontFile + '|' + ChangeFileExt(FontFile, '.pfb');
AddFontRes := AddFontResourceW(PWideChar(FontFile));
try
if AddFontRes > 0 then
begin
SetLength(LogFont, AddFontRes);
lfsz := AddFontRes * SizeOf(TLogFontW);
if not GFRI(PWideChar(FontFile), lfsz, #LogFont[0], 2) then
raise Exception.Create('GetFontResourceInfoW failed.');
AddFontRes := lfsz div SizeOf(TLogFont);
for I := 0 to AddFontRes - 1 do
begin
hFnt := CreateFontIndirectW(LogFont[I]);
try
Result := LogFont[I].lfFaceName;
finally
DeleteObject(hFnt);
end;
end; // for I := 0 to AddFontRes - 1
end; // if AddFontRes > 0
finally
RemoveFontResourceW(PWideChar(FontFile));
end;
end;
procedure TMainForm.btnFontInfoClick(Sender: TObject);
begin
if OpenDialog1.Execute then
MessageDlg(Format('The font name of %s is'#13#10'%s.', [OpenDialog1.FileName,
GetFontNameFromFile(OpenDialog1.FileName)]), mtInformation, [mbOK], 0);
end;
Here's an adaptation of RRUZ's answer with the benefit that you can enumerate and find the names of fonts in any directory, not necessarily only the installed fonts in C:\Windows. The trick is to call AddFontResource before (and RemoveFontResource after) processing it with GetFontResourceInfoW for each font file:
program font_enum;
{$APPTYPE CONSOLE}
{$R *.res}
uses
Windows,
System.SysUtils;
const
QFR_DESCRIPTION = 1;
var
p: String;
F: TSearchRec;
cbBuffer: DWORD;
lpBuffer: array [0 .. MAX_PATH - 1] of Char;
function GetFontResourceInfo(lpszFilename: PChar; var cbBuffer: DWORD; lpBuffer: PChar; dwQueryType: DWORD): DWORD;
stdcall; external 'gdi32.dll' name 'GetFontResourceInfoW';
begin
try
{ TODO -oUser -cConsole Main : Insert code here }
p := ParamStr(1);
if (p = EmptyStr) then
p := ExtractFilePath(ParamStr(0))
else if (not DirectoryExists(p)) then
begin
Writeln('Directory specified is not valid.');
Exit;
end;
p := IncludeTrailingPathDelimiter(p);
if (FindFirst(p + '*.ttf', faAnyFile - faDirectory, F) = 0) then
begin
repeat
AddFontResource(PWideChar(p + F.Name));
cbBuffer := SizeOf(lpBuffer);
GetFontResourceInfo(PWideChar(p + F.Name), cbBuffer, lpBuffer, QFR_DESCRIPTION);
Writeln(Format('%s = %s', [F.Name, lpBuffer]));
RemoveFontResource(PWideChar(p + F.Name));
until (FindNext(F) <> 0);
end;
FindClose(F);
if (FindFirst(p + '*.fon', faAnyFile - faDirectory, F) = 0) then
begin
repeat
AddFontResource(PWideChar(p + F.Name));
cbBuffer := SizeOf(lpBuffer);
GetFontResourceInfo(PWideChar(p + F.Name), cbBuffer, lpBuffer, QFR_DESCRIPTION);
Writeln(Format('%s = %s', [F.Name, lpBuffer]));
RemoveFontResource(PWideChar(p + F.Name));
until (FindNext(F) <> 0);
end;
FindClose(F);
except
on E: Exception do
Writeln(E.ClassName, ': ', E.Message);
end;
end.
I got this delphi function to join files:
procedure Join(Main_FileName, Hidden_Filename : string);
var
MainFile : TFileStream;
HiddenFile : TFileStream;
SizeOfFile : Cardinal;
SearchWord : string[10];
begin
MainFile := TFileStream.Create(Main_FileName, fmOpenReadWrite or fmShareDenyWrite);
try
SizeOfFile := MainFile.Size;
HiddenFile := TFileStream.Create(Hidden_Filename, fmOpenRead or fmShareDenyNone);
try
MainFile.Seek(0, soFromEnd);
MainFile.CopyFrom(HiddenFile, 0);
MainFile.Seek(0, soFromEnd);
finally
HiddenFile.Free;
end;
SearchWord := IntToStr(SizeOfFile) + #0;
MainFile.Seek(0, soFromEnd);
MainFile.WriteBuffer(SearchWord, SizeOf(SearchWord));
finally
MainFile.Free;
end;
end;
And need to port this in ruby.
The created file should compatible with this delphi split function:
(Exists in delphi only no ruby port needed)
procedure Split(Main_FileName, NewFromMain_Filename : string);
var
MainFile : TFileStream;
SplitFile : TFileStream;
HelpStr : string[10];
GetSize : integer;
begin
MainFile := TFileStream.create(Main_FileName, fmOpenReadWrite or fmShareDenyWrite);
try
SplitFile := TFileStream.Create(NewFromMain_Filename, fmCreate or fmShareDenyNone);
try
MainFile.Position := MainFile.Size - 11;
MainFile.Read(HelpStr, 10);
GetSize := StrToInt(HelpStr);
MainFile.Position := GetSize;
SplitFile.CopyFrom(MainFile, MainFile.Size-GetSize);
SplitFile.Size := SplitFile.Size - 11;
MainFile.Size := GetSize;
finally
SplitFile.Free;
end;
finally
MainFile.Free;
end;
end;
Source of the delphi functions in from here:
http://www.delphi-treff.de/tipps/dateienverzeichnisse/dateioperationen/dateien-miteinander-verschmelzen/
Here is the Ruby way - short, readable and easy:
size = File.size("mainfile")
File.open("mainfile", "ab") {|mf|
File.open("hiddenfile", "rb") { |hf|
mf.write(hf.read)
mf.write("#{size}\x0".ljust(10))
}
}
didn't check it split works, have no delphi
This question already has answers here:
Closed 12 years ago.
Possible Duplicates:
Getting Machine’s MAC Address — Good Solution?
How do I get the MAC address of a network card using Delphi?
I am using MAC address as hardware id for protection(ofcourse I have encrypted this data)
I am using below code to get MAC address on user computer
function MacAddress: string;
var
Lib: Cardinal;
Func: function(GUID: PGUID): Longint; stdcall;
GUID1, GUID2: TGUID;
begin
Result := '';
Lib := LoadLibrary('rpcrt4.dll');
if Lib <> 0 then
begin
#Func := GetProcAddress(Lib, 'UuidCreateSequential');
if Assigned(Func) then
begin
if (Func(#GUID1) = 0) and
(Func(#GUID2) = 0) and
(GUID1.D4[2] = GUID2.D4[2]) and
(GUID1.D4[3] = GUID2.D4[3]) and
(GUID1.D4[4] = GUID2.D4[4]) and
(GUID1.D4[5] = GUID2.D4[5]) and
(GUID1.D4[6] = GUID2.D4[6]) and
(GUID1.D4[7] = GUID2.D4[7]) then
begin
Result :=
IntToHex(GUID1.D4[2], 2) + '-' +
IntToHex(GUID1.D4[3], 2) + '-' +
IntToHex(GUID1.D4[4], 2) + '-' +
IntToHex(GUID1.D4[5], 2) + '-' +
IntToHex(GUID1.D4[6], 2) + '-' +
IntToHex(GUID1.D4[7], 2);
end;
end;
end;
end;
above code works perfectly on windows XP
but its giving different values in windows7 ,the value changing every time after computer resratred :(
is there any chance of getting MAC address thats constant (unless user changed his MAC address)
or is there any good code which retrvies constant data on all OS ?
thanks in advance
#steve0, to retrieve the mac address of an Network Adapter you can use the WMI and the Win32_NetworkAdapterConfiguration Class and check the MACAddress property.
Check this code:
program WMI_MAC;
{$APPTYPE CONSOLE}
uses
SysUtils
,ActiveX
,ComObj
,Variants;
function VarToStrNil(Value:Variant):string; //Dummy function to onvert an variant value to string
begin
if VarIsNull(Value) then
Result:=''
else
Result:=VarToStr(Value);
end;
Procedure GetMacAddress;
var
objWMIService : OLEVariant;
colItems : OLEVariant;
colItem : OLEVariant;
oEnum : IEnumvariant;
iValue : LongWord;
wmiHost, root, wmiClass: string;
function GetWMIObject(const objectName: String): IDispatch;
var
chEaten: Integer;
BindCtx: IBindCtx;//for access to a bind context
Moniker: IMoniker;//Enables you to use a moniker object
begin
OleCheck(CreateBindCtx(0, bindCtx));
OleCheck(MkParseDisplayName(BindCtx, StringToOleStr(objectName), chEaten, Moniker));//Converts a string into a moniker that identifies the object named by the string
OleCheck(Moniker.BindToObject(BindCtx, nil, IDispatch, Result));//Binds to the specified object
end;
begin
wmiHost := '.';
root := 'root\CIMV2';
wmiClass := 'Win32_NetworkAdapterConfiguration';
objWMIService := GetWMIObject(Format('winmgmts:\\%s\%s',[wmiHost,root]));
colItems := objWMIService.ExecQuery(Format('SELECT * FROM %s',[wmiClass]),'WQL',0);
oEnum := IUnknown(colItems._NewEnum) as IEnumVariant;
while oEnum.Next(1, colItem, iValue) = 0 do
//if VarToStrNil(colItem.MACAddress)<>'' then //uncomment if you only want list the interfaces with mac adress
//if colItem.IPEnabled then // uncomment if you only want list the active interfaces
begin
WriteLn('Card Description '+VarToStrNil(colItem.Caption));
WriteLn('MACAddress '+VarToStrNil(colItem.MACAddress));
end;
end;
begin
try
CoInitialize(nil);
try
GetMacAddress;
Readln;
finally
CoUninitialize;
end;
except
on E:Exception do
Begin
Writeln(E.Classname, ': ', E.Message);
Readln;
End;
end;
end.
Here is some code working well for any computer on your network - may try it to get your own, using '127.0.0.1' as IP:
function GetRemoteMacAddress(const IP: AnsiString): TSockData;
// implements http://msdn.microsoft.com/en-us/library/aa366358(VS.85).aspx
type
TSendARP = function(DestIp: DWORD; srcIP: DWORD; pMacAddr: pointer; PhyAddrLen: Pointer): DWORD; stdcall;
const
HexChars: array[0..15] of AnsiChar = '0123456789ABCDEF';
var dwRemoteIP: DWORD;
PhyAddrLen: Longword;
pMacAddr : array [0..7] of byte;
I: integer;
P: PAnsiChar;
SendARPLibHandle: THandle;
SendARP: TSendARP;
begin
result := '';
SendARPLibHandle := LoadLibrary('iphlpapi.dll');
if SendARPLibHandle<>0 then
try
SendARP := GetProcAddress(SendARPLibHandle,'SendARP');
if #SendARP=nil then
exit; // we are not under 2K or later
dwremoteIP := inet_addr(pointer(IP));
if dwremoteIP<>0 then begin
PhyAddrLen := 8;
if SendARP(dwremoteIP, 0, #pMacAddr, #PhyAddrLen)=NO_ERROR then begin
if PhyAddrLen=6 then begin
SetLength(result,12);
P := pointer(result);
for i := 0 to 5 do begin
P[0] := HexChars[pMacAddr[i] shr 4];
P[1] := HexChars[pMacAddr[i] and $F];
inc(P,2);
end;
end;
end;
end;
finally
FreeLibrary(SendARPLibHandle);
end;
end;
This code is extracted from our freeware and open source framework, unit SynCrtSock.pas. See http://synopse.info/fossil