WebSVN – userdetect2 – Diff – /trunk/UserDetect2/Plugins/LAN_MAC.dpr


library LAN_MAC;
 
uses
  Windows,
  SysUtils,
  Classes,
  UD2_PluginIntf in '..\UD2_PluginIntf.pas',
  UD2_PluginUtils in '..\UD2_PluginUtils.pas',
  UD2_PluginStatus in '..\UD2_PluginStatus.pas',
  NetworkUtils in 'NetworkUtils.pas';
 
{$R *.res}
 
const
  PLUGIN_GUID: TGUID = '{8E1AA598-67A6-4128-BB9F-7E624647F584}';
 
function PluginIdentifier: TGUID; cdecl;
begin
  result := PLUGIN_GUID;
end;
 
function IdentificationStringW(lpIdentifier: LPWSTR; cchSize: DWORD): UD2_STATUS; cdecl;
var
  sl, sl2: TStringList;
  i: integer;
  ip, mac: string;
  ec: DWORD;
begin
  try
    sl := TStringList.Create;
    sl2 := TStringList.Create;
    try
      ec := GetLocalMACAddressList(sl2);
      if ec = ERROR_NOT_SUPPORTED then
      begin
        result := UD2_STATUS_NOTAVAIL_OS_NOT_SUPPORTED;
        Exit;
      end
      else if ec <> ERROR_SUCCESS then
      begin
        result := UD2_STATUS_OSError(ec);
        Exit;
      end;
 
      // This procedure should not find any more MAC addresses...
      GetLocalIPAddressList(sl);
      for i := 0 to sl.Count-1 do
      begin
        ip := sl.Strings[i];
        ec := GetMACAddress(ip, mac);
        if ec = ERROR_NOT_SUPPORTED then
        begin
          result := UD2_STATUS_NOTAVAIL_OS_NOT_SUPPORTED;
          Exit;
        end
        else if (ec = S_OK) and
                (mac <> '') and
                (sl2.IndexOf(mac) = -1) then
        begin
          sl2.add(mac);
        end;
      end;
      result := UD2_WriteStringListToPointerW(lpIdentifier, cchSize, sl2);
    finally
      sl.Free;
      sl2.Free;
    end;
  except
    on E: Exception do result := UD2_STATUS_HandleException(E);
  end;
end;
 
function PluginNameW(lpPluginName: LPWSTR; cchSize: DWORD; wLangID: LANGID): UD2_STATUS; cdecl;
var
  stPluginName: WideString;
  primaryLangID: Byte;
begin
  primaryLangID := wLangID and $00FF;
  if primaryLangID = LANG_GERMAN then
    stPluginName := 'MAC-Adressen'
  else
    stPluginName := 'MAC addresses';
  result := UD2_WritePascalStringToPointerW(lpPluginName, cchSize, stPluginName);
end;
 
function PluginVendorW(lpPluginVendor: LPWSTR; cchSize: DWORD; wLangID: LANGID): UD2_STATUS; cdecl;
begin
  result := UD2_WritePascalStringToPointerW(lpPluginVendor, cchSize, 'ViaThinkSoft');
end;
 
function PluginVersionW(lpPluginVersion: LPWSTR; cchSize: DWORD; wLangID: LANGID): UD2_STATUS; cdecl;
begin
  result := UD2_WritePascalStringToPointerW(lpPluginVersion, cchSize, '1.0');
end;
 
function IdentificationMethodNameW(lpIdentificationMethodName: LPWSTR; cchSize: DWORD): UD2_STATUS; cdecl;
var
  stIdentificationMethodName: WideString;
begin
  stIdentificationMethodName := 'LAN_MAC';
  result := UD2_WritePascalStringToPointerW(lpIdentificationMethodName, cchSize, stIdentificationMethodName);
end;
 
function CheckLicense(lpReserved: LPVOID): UD2_STATUS; cdecl;
begin
  result := UD2_STATUS_OK_LICENSED;
end;
 
function DescribeOwnStatusCodeW(lpErrorDescription: LPWSTR; cchSize: DWORD; statusCode: UD2_STATUS; wLangID: LANGID): BOOL; cdecl;
begin
  // This function does not use non-generic status codes
  result := FALSE;
end;
 
exports
  PluginInterfaceID         name mnPluginInterfaceID,
  PluginIdentifier          name mnPluginIdentifier,
  PluginNameW               name mnPluginNameW,
  PluginVendorW             name mnPluginVendorW,
  PluginVersionW            name mnPluginVersionW,
  IdentificationMethodNameW name mnIdentificationMethodNameW,
  IdentificationStringW     name mnIdentificationStringW,
  CheckLicense              name mnCheckLicense,
  DescribeOwnStatusCodeW    name mnDescribeOwnStatusCodeW;
 
end.
 

Rev 71	Rev 82
1	library LAN_MAC;	1	library LAN_MAC;
2		2
3	uses	3	uses
4	Windows,	4	Windows,
5	SysUtils,	5	SysUtils,
6	Classes,	6	Classes,
7	UD2_PluginIntf in '..\UD2_PluginIntf.pas',	7	UD2_PluginIntf in '..\UD2_PluginIntf.pas',
8	UD2_PluginUtils in '..\UD2_PluginUtils.pas',	8	UD2_PluginUtils in '..\UD2_PluginUtils.pas',
9	UD2_PluginStatus in '..\UD2_PluginStatus.pas',	9	UD2_PluginStatus in '..\UD2_PluginStatus.pas',
10	NetworkUtils in 'NetworkUtils.pas';	10	NetworkUtils in 'NetworkUtils.pas';
11		11
12	{$R *.res}	12	{$R *.res}
13		13
14	const	14	const
15	PLUGIN_GUID: TGUID = '{8E1AA598-67A6-4128-BB9F-7E624647F584}';	15	PLUGIN_GUID: TGUID = '{8E1AA598-67A6-4128-BB9F-7E624647F584}';
16		16
17	function PluginIdentifier: TGUID; cdecl;	17	function PluginIdentifier: TGUID; cdecl;
18	begin	18	begin
19	result := PLUGIN_GUID;	19	result := PLUGIN_GUID;
20	end;	20	end;
21		21
22	function IdentificationStringW(lpIdentifier: LPWSTR; cchSize: DWORD): UD2_STATUS; cdecl;	22	function IdentificationStringW(lpIdentifier: LPWSTR; cchSize: DWORD): UD2_STATUS; cdecl;
23	var	23	var
24	sl, sl2: TStringList;	24	sl, sl2: TStringList;
25	i: integer;	25	i: integer;
26	ip, mac: string;	26	ip, mac: string;
27	ec: DWORD;	27	ec: DWORD;
28	begin	28	begin
-		29	try
29	sl := TStringList.Create;	30	sl := TStringList.Create;
30	sl2 := TStringList.Create;	31	sl2 := TStringList.Create;
31	try	32	try
32	ec := GetLocalMACAddressList(sl2);	33	ec := GetLocalMACAddressList(sl2);
33	if ec = ERROR_NOT_SUPPORTED then	34	if ec = ERROR_NOT_SUPPORTED then
34	begin	35	begin
35	result := UD2_STATUS_NOTAVAIL_OS_NOT_SUPPORTED;	36	result := UD2_STATUS_NOTAVAIL_OS_NOT_SUPPORTED;
36	Exit;	37	Exit;
37	end	38	end
38	else if ec <> ERROR_SUCCESS then	39	else if ec <> ERROR_SUCCESS then
39	begin	40	begin
40	result := UD2_STATUS_OSError(ec);	41	result := UD2_STATUS_OSError(ec);
41	Exit;	42	Exit;
42	end;	43	end;
43		44
44	// This procedure should not find any more MAC addresses...	45	// This procedure should not find any more MAC addresses...
45	GetLocalIPAddressList(sl);	46	GetLocalIPAddressList(sl);
46	for i := 0 to sl.Count-1 do	47	for i := 0 to sl.Count-1 do
47	begin	48	begin
48	ip := sl.Strings[i];	49	ip := sl.Strings[i];
49	ec := GetMACAddress(ip, mac);	50	ec := GetMACAddress(ip, mac);
50	if ec = ERROR_NOT_SUPPORTED then	51	if ec = ERROR_NOT_SUPPORTED then
51	begin	52	begin
52	result := UD2_STATUS_NOTAVAIL_OS_NOT_SUPPORTED;	53	result := UD2_STATUS_NOTAVAIL_OS_NOT_SUPPORTED;
53	Exit;	54	Exit;
54	end	55	end
55	else if (ec = S_OK) and	56	else if (ec = S_OK) and
56	(mac <> '') and	57	(mac <> '') and
57	(sl2.IndexOf(mac) = -1) then	58	(sl2.IndexOf(mac) = -1) then
58	begin	59	begin
59	sl2.add(mac);	60	sl2.add(mac);
60	end;	61	end;
61	end;	62	end;
62	result := UD2_WriteStringListToPointerW(lpIdentifier, cchSize, sl2);	63	result := UD2_WriteStringListToPointerW(lpIdentifier, cchSize, sl2);
63	finally	64	finally
64	sl.Free;	65	sl.Free;
65	sl2.Free;	66	sl2.Free;
66	end;	67	end;
-		68	except
-		69	on E: Exception do result := UD2_STATUS_HandleException(E);
-		70	end;
67	end;	71	end;
68		72
69	function PluginNameW(lpPluginName: LPWSTR; cchSize: DWORD; wLangID: LANGID): UD2_STATUS; cdecl;	73	function PluginNameW(lpPluginName: LPWSTR; cchSize: DWORD; wLangID: LANGID): UD2_STATUS; cdecl;
70	var	74	var
71	stPluginName: WideString;	75	stPluginName: WideString;
72	primaryLangID: Byte;	76	primaryLangID: Byte;
73	begin	77	begin
74	primaryLangID := wLangID and $00FF;	78	primaryLangID := wLangID and $00FF;
75	if primaryLangID = LANG_GERMAN then	79	if primaryLangID = LANG_GERMAN then
76	stPluginName := 'MAC-Adressen'	80	stPluginName := 'MAC-Adressen'
77	else	81	else
78	stPluginName := 'MAC addresses';	82	stPluginName := 'MAC addresses';
79	result := UD2_WritePascalStringToPointerW(lpPluginName, cchSize, stPluginName);	83	result := UD2_WritePascalStringToPointerW(lpPluginName, cchSize, stPluginName);
80	end;	84	end;
81		85
82	function PluginVendorW(lpPluginVendor: LPWSTR; cchSize: DWORD; wLangID: LANGID): UD2_STATUS; cdecl;	86	function PluginVendorW(lpPluginVendor: LPWSTR; cchSize: DWORD; wLangID: LANGID): UD2_STATUS; cdecl;
83	begin	87	begin
84	result := UD2_WritePascalStringToPointerW(lpPluginVendor, cchSize, 'ViaThinkSoft');	88	result := UD2_WritePascalStringToPointerW(lpPluginVendor, cchSize, 'ViaThinkSoft');
85	end;	89	end;
86		90
87	function PluginVersionW(lpPluginVersion: LPWSTR; cchSize: DWORD; wLangID: LANGID): UD2_STATUS; cdecl;	91	function PluginVersionW(lpPluginVersion: LPWSTR; cchSize: DWORD; wLangID: LANGID): UD2_STATUS; cdecl;
88	begin	92	begin
89	result := UD2_WritePascalStringToPointerW(lpPluginVersion, cchSize, '1.0');	93	result := UD2_WritePascalStringToPointerW(lpPluginVersion, cchSize, '1.0');
90	end;	94	end;
91		95
92	function IdentificationMethodNameW(lpIdentificationMethodName: LPWSTR; cchSize: DWORD): UD2_STATUS; cdecl;	96	function IdentificationMethodNameW(lpIdentificationMethodName: LPWSTR; cchSize: DWORD): UD2_STATUS; cdecl;
93	var	97	var
94	stIdentificationMethodName: WideString;	98	stIdentificationMethodName: WideString;
95	begin	99	begin
96	stIdentificationMethodName := 'LAN_MAC';	100	stIdentificationMethodName := 'LAN_MAC';
97	result := UD2_WritePascalStringToPointerW(lpIdentificationMethodName, cchSize, stIdentificationMethodName);	101	result := UD2_WritePascalStringToPointerW(lpIdentificationMethodName, cchSize, stIdentificationMethodName);
98	end;	102	end;
99		103
100	function CheckLicense(lpReserved: LPVOID): UD2_STATUS; cdecl;	104	function CheckLicense(lpReserved: LPVOID): UD2_STATUS; cdecl;
101	begin	105	begin
102	result := UD2_STATUS_OK_LICENSED;	106	result := UD2_STATUS_OK_LICENSED;
103	end;	107	end;
104		108
105	function DescribeOwnStatusCodeW(lpErrorDescription: LPWSTR; cchSize: DWORD; statusCode: UD2_STATUS; wLangID: LANGID): BOOL; cdecl;	109	function DescribeOwnStatusCodeW(lpErrorDescription: LPWSTR; cchSize: DWORD; statusCode: UD2_STATUS; wLangID: LANGID): BOOL; cdecl;
106	begin	110	begin
107	// This function does not use non-generic status codes	111	// This function does not use non-generic status codes
108	result := FALSE;	112	result := FALSE;
109	end;	113	end;
110		114
111	exports	115	exports
112	PluginInterfaceID name mnPluginInterfaceID,	116	PluginInterfaceID name mnPluginInterfaceID,
113	PluginIdentifier name mnPluginIdentifier,	117	PluginIdentifier name mnPluginIdentifier,
114	PluginNameW name mnPluginNameW,	118	PluginNameW name mnPluginNameW,
115	PluginVendorW name mnPluginVendorW,	119	PluginVendorW name mnPluginVendorW,
116	PluginVersionW name mnPluginVersionW,	120	PluginVersionW name mnPluginVersionW,
117	IdentificationMethodNameW name mnIdentificationMethodNameW,	121	IdentificationMethodNameW name mnIdentificationMethodNameW,
118	IdentificationStringW name mnIdentificationStringW,	122	IdentificationStringW name mnIdentificationStringW,
119	CheckLicense name mnCheckLicense,	123	CheckLicense name mnCheckLicense,
120	DescribeOwnStatusCodeW name mnDescribeOwnStatusCodeW;	124	DescribeOwnStatusCodeW name mnDescribeOwnStatusCodeW;
121		125
122	end.	126	end.
123		127

Subversion Repositories userdetect2

userdetect2/trunk/UserDetect2/Plugins/LAN_MAC.dpr – Rev 71 → 82