Новичок
Профиль
Группа: Участник
Сообщений: 32
Регистрация: 22.9.2007
Репутация: нет
Всего: нет
|
Доброго времени суток уважаемые товарищи программисты! Есть в наличии устройство работающее через COM-Port, есть написанное под него приложение которое отправляет устройству команды и получает от него ответы. приложение вполне работоспособно и функционально работает с портом по средству BComPort. Но вот стала необходимость быстро перевести код приложения в dll библиотеку из которой будет экспортироваться всего несколько функций. Думаю ну задача та простая банально подключаю к библиотеке pas файл из которого и идет работа с программой а процедуры которые были в программе перегоняю в 2 функции библиотеки. Все было прекрасно библиотека создалась тестовое приложение для работы с ней готово. Но вот всплыла проблема после запуска тестового приложения данные в контроллер отправляются а обратно ничего не приходит, в тоже время проверяю работу через первое приложение там все нормально работает и отправляется и передается, а вот через dll ничего хорошего не происходит. Помогите может кто сталкивался с подобными ситуациями. Заранее благодарю! | Код |
{Основное работающее приложение}
unit main_Form;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, usbToken, XPMan;
type
TForm1 = class(TForm)
openPort: TButton;
GroupBox1: TGroupBox;
tokenIdent: TButton;
autoGenButton: TButton;
randomEditIdent: TLabeledEdit;
autoGenEnable: TCheckBox;
XPManifest1: TXPManifest;
keyTokenEdit: TLabeledEdit;
resultLabel: TLabel;
closePort: TButton;
GroupBox2: TGroupBox;
guidSoftwareEdit: TLabeledEdit;
keySoftwareName: TLabeledEdit;
softwareIdent: TButton;
resultLabelSoft: TLabel;
procedure autoGenEnableClick(Sender: TObject);
procedure tokenIdentClick(Sender: TObject);
procedure autoGenButtonClick(Sender: TObject);
procedure openPortClick(Sender: TObject);
procedure closePortClick(Sender: TObject);
procedure softwareIdentClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
uses DateUtils;
procedure TForm1.autoGenEnableClick(Sender: TObject);
begin
if autoGenEnable.Checked then
begin
autoGenButton.Visible := true;
end
else
begin
autoGenButton.Visible := false;
end;
end;
procedure TForm1.tokenIdentClick(Sender: TObject);
var temp, key, randomNumber : string;
chipherText, outText : word;
begin
randomEditIdent.Enabled := false;
keyTokenEdit.Enabled := false;
temp := '';
randomNumber := randomEditIdent.Text;
key := keyTokenEdit.Text;
if (length(randomNumber) = 4) and (length(key) = 8) then
begin
temp := tokenUsb.tarIdentification(randomNumber);
if temp ='noAnsw' then
begin
Application.MessageBox('Устройтво не отвечает! Убедитесь в правильности подключения и номера порта.', 'Внимание!', MB_OK + MB_ICONINFORMATION);
randomEditIdent.Enabled := true;
keyTokenEdit.Enabled := true;
end
else
begin
temp := copy(temp, 4, 4);
try
chipherText := StrToInt('$' + temp);
except
NULL;
end;
outText := tokenUsb.decryptBlockFeistel(StrToInt('$' + key), chipherText);
if outText = StrToInt('$' + randomNumber) then
begin
resultLabel.Caption := 'Ключ обнаружен';
GroupBox2.Enabled := true;
end
else
resultLabel.Caption := 'Ключ не обнаружен';
randomEditIdent.Enabled := true;
keyTokenEdit.Enabled := true;
end;
end
else
begin
Application.MessageBox('Допускаются шестнадцатиричные числа длинной 2 байта.', 'Введены не коректные данные!', MB_OK + MB_ICONINFORMATION);
randomEditIdent.Enabled := true;
keyTokenEdit.Enabled := true;
end;
end;
procedure TForm1.autoGenButtonClick(Sender: TObject);
var
temp : word;
tyear,tmonth,tday,thour,tmin,tsec,tmsec: word;
begin
{ if length(beginNumberEdit.Text) = 4 then
begin
temp := tokenUsb.generatorCongruential(StrToInt('$' + beginNumberEdit.Text));
randomEditIdent.Text := IntToHex(temp, 4);
end
else
Application.MessageBox('Допускаются шестнадцатиричные числа длинной 2 байта.', 'Введены не коректные данные!', MB_OK + MB_ICONINFORMATION);}
DecodeDateTime(now,tyear,tmonth,tday,thour,tmin,tsec,tmsec);
temp:= tyear + tmonth + tday + thour + tmin + tsec + tmsec;
temp := tokenUsb.generatorCongruential(temp);
randomEditIdent.Text := IntToHex(temp, 4);
end;
procedure TForm1.openPortClick(Sender: TObject);
begin
tokenUsb.initComPort('COM1');
if tokenUsb.openComPort then
begin
openPort.Enabled := false;
closePort.Enabled := true;
GroupBox1.Enabled :=true;
end;
end;
procedure TForm1.closePortClick(Sender: TObject);
begin
if tokenUsb.closeComPort then
begin
openPort.Enabled := true;
closePort.Enabled := false;
GroupBox1.Enabled := false;
end;
end;
procedure TForm1.softwareIdentClick(Sender: TObject);
var softwareGuid, keySoftware, temp : string;
imitoToSend : word;
begin
temp := ''; imitoToSend := $0000;
keySoftware := keySoftwareName.Text;
softwareGuid := guidSoftwareEdit.Text;
if (length(keySoftware) = 8) and (length(softwareGuid) = 32)then
begin
temp := tokenUsb.parIdentification;
if temp ='noAnsw' then
Application.MessageBox('Устройтво не отвечает! Убедитесь в правильности подключения и номера порта.', 'Внимание!', MB_OK + MB_ICONINFORMATION)
else
begin
temp := copy(temp, 4, 4);
imitoToSend := tokenUsb.imitoCreate(StrToInt('$' + temp),StrToInt('$' + keySoftware), softwareGuid);
temp := '';
temp := tokenUsb.pairIdentification(IntToHex(imitoToSend, 4));
temp := copy(temp, 5, 3);
if temp = 'YES' then
resultLabelSoft.Caption := 'ПО идентифицировано'
else
resultLabelSoft.Caption := 'ПО не идентифицировано';
end;
end;
end;
end.
|
| Код |
{модуль подключаемый к основному приложению}
unit usbToken;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, BCPort, ExtCtrls;
type
TtokenUsb = class(TForm)
Timer1: TTimer;
BComPort1: TBComPort;
function initComPort(nameCom : string): boolean;
function closeComPort:boolean;
function openComPort:boolean;
function generatorCongruential(initNumber : word):word;
function tarIdentification(str : string):string;
function parIdentification:string;
function pairIdentification(str : string):string;
function cidrIdentification(str : string):string;
function nidrIdentification(str : string):string;
function nkyrIdentification(str : string):string;
procedure comPortRxChar(Sender: TObject; Count: Integer);
procedure Timer1Timer(Sender: TObject);
function decryptBlockFeistel(key : longword; dataBlock : word) : word;
function encryptBlockFeistel(key : longword; dataBlock : word) : word;
function functionFeistel(blockHalf : byte; keyRound : byte): byte;
function imitoCreate (randomNumberInit : word; key : longword; idSoftware : string):word;
private
{ Private declarations }
public
{ Public declarations }
end;
var
tokenUsb: TtokenUsb;
recievedFullData : string;
pairSent, tarSent, parSent, cidrSent, nidrSent, nkyrSent : boolean;
implementation
{$R *.dfm}
function TtokenUsb.initComPort(nameCom : string): boolean;
begin
BComPort1.Port := nameCom;
end;
function TtokenUsb.generatorCongruential(initNumber : word):word;
begin
generatorCongruential := ($00AB * initNumber + $2BCD) mod $CF85;
end;
function TtokenUsb.tarIdentification(str : string):string;
begin
tarSent := true; parSent := false; pairSent := false;
recievedFullData := '';
BComPort1.ClearBuffer(true, true);
BComPort1.WriteStr('TAR' + str + #13);
Timer1.Enabled := true;
While tarSent do Application.ProcessMessages;
tarIdentification := recievedFullData;
end;
function TtokenUsb.parIdentification:string;
begin
parSent := true; tarSent := false; pairSent := false;
recievedFullData := '';
BComPort1.ClearBuffer(true, true);
BComPort1.WriteStr('PAR' + #13);
Timer1.Enabled := true;
While parSent do Application.ProcessMessages;
parIdentification := recievedFullData;
end;
function TtokenUsb.pairIdentification(str : string):string;
begin
pairSent := true; parSent := false; tarSent := false;
recievedFullData := '';
BComPort1.ClearBuffer(true, true);
BComPort1.WriteStr('PAIR' + str + #13);
Timer1.Enabled := true;
While pairSent do Application.ProcessMessages;
pairIdentification := recievedFullData;
end;
function TtokenUsb.cidrIdentification(str : string):string;
begin
recievedFullData := '';
BComPort1.ClearBuffer(true, true);
cidrSent := true; tarSent := false;
BComPort1.WriteStr('CIDR' + str + #13);
Timer1.Enabled := true;
While cidrSent do Application.ProcessMessages;
cidrIdentification := recievedFullData;
end;
function TtokenUsb.nidrIdentification(str : string):string;
begin
recievedFullData := '';
BComPort1.ClearBuffer(true, true);
nidrSent := true;
BComPort1.WriteStr('NIDR' + str + #13);
Timer1.Enabled := true;
While nidrSent do Application.ProcessMessages;
nidrIdentification := recievedFullData;
end;
function TtokenUsb.nkyrIdentification(str : string):string;
begin
recievedFullData := '';
BComPort1.ClearBuffer(true, true);
nkyrSent := true;
BComPort1.WriteStr('NKYR' + str + #13);
Timer1.Enabled := true;
While nkyrSent do Application.ProcessMessages;
nkyrIdentification := recievedFullData;
end;
function TtokenUsb.openComPort:boolean;
begin
if not BComPort1.Connected
then
begin
openComPort := BComPort1.Open;
BComPort1.ClearBuffer(true, true);
end
else
Application.MessageBox('Невозможно открыть порт! Данный порт уже открыт!', 'Внимание!', MB_OK + MB_ICONINFORMATION);
end;
function TtokenUsb.closeComPort:boolean;
begin
if BComPort1.Connected
then
closeComPort := BComPort1.Close;
end;
procedure TtokenUsb.comPortRxChar(Sender: TObject; Count: Integer);
var receiveString : string;
begin
Timer1.Enabled := false;
receiveString := '';
if tarSent = true
then
begin
BComPort1.ReadStr(receiveString, Count);
recievedFullData := recievedFullData + receiveString;
if receiveString[Count] = #13 then
begin
tarSent := false;
end;
end;
if parSent = true
then
begin
BComPort1.ReadStr(receiveString, Count);
recievedFullData := recievedFullData + receiveString;
if receiveString[Count] = #13 then
begin
parSent := false;
end;
end;
if pairSent = true
then
begin
BComPort1.ReadStr(receiveString, Count);
recievedFullData := recievedFullData + receiveString;
if receiveString[Count] = #13 then
begin
pairSent := false;
end;
end;
if cidrSent = true
then
begin
BComPort1.ReadStr(receiveString, Count);
recievedFullData := recievedFullData + receiveString;
if receiveString[Count] = #13 then
begin
cidrSent := false;
end;
end;
if nidrSent = true
then
begin
BComPort1.ReadStr(receiveString, Count);
recievedFullData := recievedFullData + receiveString;
if receiveString[Count] = #13 then
begin
nidrSent := false;
end;
end;
if nkyrSent = true
then
begin
BComPort1.ReadStr(receiveString, Count);
recievedFullData := recievedFullData + receiveString;
if receiveString[Count] = #13 then
begin
nkyrSent := false;
end;
end;
end;
function TtokenUsb.decryptBlockFeistel(key : longword; dataBlock : word) : word;
const rounds = 4;
var
roundKey : array[0..3] of byte;
leftBlock, rightBlock : byte;
temp : byte;
resultf : word;
i : integer;
begin
for i := 0 to 3 do
roundKey[i] := 0;
leftBlock := 0;
rightBlock := 0;
temp := 0;
resultf := 0;
for i := rounds - 1 downto 0 do //Разбиение ключа на раундовые ключи
begin
roundKey[i] := key and $00000FF;
if i <> 0
then
key := key shr 8;
end;
rightBlock := dataBlock and $00FF; //
dataBlock := dataBlock shr 8; // Разбиение блока данных на левый и правый под блоки
leftBlock := dataBlock and $00FF; //
for i := rounds - 1 downto 0 do //Раунды шифрования
begin
temp := leftBlock xor functionFeistel(rightBlock, roundKey[i]);
leftBlock := rightBlock;
rightBlock := temp;
end;
resultf := resultf or leftBlock; //
resultf := resultf shl 8; // Склеивание левого и правого блока в один
resultf := resultf or rightBlock; //
decryptBlockFeistel := resultf; // Возвращение результата
end;
function TtokenUsb.encryptBlockFeistel(key : longword; dataBlock : word) : word;
const rounds = 4;
var
roundKey : array[0..3] of byte;
leftBlock, rightBlock : byte;
temp : byte;
resultf : word;
i : integer;
begin
for i := 0 to 3 do
roundKey[i] := 0;
leftBlock := 0;
rightBlock := 0;
temp := 0;
resultf := 0;
for i := rounds - 1 downto 0 do //Разбиение ключа на раундовые ключи
begin
roundKey[i] := key and $00000FF;
if i <> 0
then
key := key shr 8;
end;
rightBlock := dataBlock and $00FF; //
dataBlock := dataBlock shr 8; // Разбиение блока данных на левый и правый под блоки
leftBlock := dataBlock and $00FF; //
for i := 0 to rounds - 1 do //Раунды шифрования
begin
temp := rightBlock xor functionFeistel(leftBlock, roundKey[i]);
rightBlock := leftBlock;
leftBlock := temp;
end;
resultf := resultf or leftBlock; //
resultf := resultf shl 8; // Склеивание левого и правого блока в один
resultf := resultf or rightBlock; //
encryptBlockFeistel := resultf; // Возвращение результата
end;
function TtokenUsb.functionFeistel(blockHalf : byte; keyRound : byte): byte;
const tableOne : array [0..15] of byte = ($5, $4, $E, $2, $B, $F, $0, $6, $C, $8, $9, $D, $7, $3, $A, $1);
const tableTwo : array [0..15] of byte = ($2, $E, $B, $A, $F, $4, $0, $3, $C, $7, $1, $9, $8, $5, $6, $D);
var
temp, tempHigh, tempLow : byte;
begin
temp := blockHalf * keyRound;
tempLow := temp and $0F; // Выделяем младшую и старшую часть
tempHigh := temp and $F0; //
tempHigh := tempHigh shr 4; //
tempLow := tableOne[tempLow]; //Производим замену
tempHigh := tableTwo[tempHigh]; //
tempHigh := tempHigh shl 4;
temp := tempHigh or tempLow;
functionFeistel := temp;
end;
function TtokenUsb.imitoCreate(randomNumberInit : word; key : longword; idSoftware : string):word;
var temp : word;
dataBlock : array[1..8] of word;
i, n : integer;
begin
for i := 1 to 8 do
dataBlock[i] := $0000;
temp := $0000;
n := 1;
i := 1;
While i <= 32 do
begin
dataBlock[n] := StrToInt ('$' + copy(idSoftware,i, 4));
inc(n);
i := i + 4;
end;
temp := randomNumberInit;
for i := 1 to 8 do
begin
temp := dataBlock[i] xor encryptBlockFeistel(key, temp);
end;
imitoCreate := temp;
end;
procedure TtokenUsb.Timer1Timer(Sender: TObject);
begin
Timer1.Enabled := false;
if tarSent = true then
begin
recievedFullData := 'noAnsw';
tarSent := false;
end;
if parSent = true then
begin
recievedFullData := 'noAnsw';
parSent := false;
end;
if pairSent = true then
begin
recievedFullData := 'noAnsw';
pairSent := false;
end;
if tarSent = true then
begin
recievedFullData := 'noAnsw';
tarSent := false;
end;
if cidrSent = true then
begin
recievedFullData := 'noAnsw';
cidrSent := false;
end;
if nidrSent = true then
begin
recievedFullData := 'noAnsw';
nidrSent := false;
end;
if nkyrSent = true then
begin
recievedFullData := 'noAnsw';
nkyrSent := false;
end;
end;
end.
initialization
parSent := false;
tarSent := false;
pairSent := false;
|
| Код |
{Библиотека которую пытаюсь создать}
library sdk;
{ Important note about DLL memory management: ShareMem must be the
first unit in your library's USES clause AND your project's (select
Project-View Source) USES clause if your DLL exports any procedures or
functions that pass strings as parameters or function results. This
applies to all strings passed to and from your DLL--even those that
are nested in records and classes. ShareMem is the interface unit to
the BORLNDMM.DLL shared memory manager, which must be deployed along
with your DLL. To avoid using BORLNDMM.DLL, pass string information
using PChar or ShortString parameters. }
uses
SysUtils,
Classes,
Dialogs,
forms,
usbToken in 'usbToken.pas';
{$R *.res}
Function proverka(rand,k: string): string; stdcall;
var
temp,randomNumber,key : string;
chipherText, outText: word;
begin
tokenUsb:= TtokenUsb.Create(nil);
tokenusb.BComPort1.Close;
tokenusb.BComPort1.Port:= 'COM1';
tokenusb.BComPort1.Open;
temp:='';
chipherText:=0;
randomNumber:= rand;
key:= k;
if (length(randomNumber)=4)and(length(key)=8) then
begin
temp:= tokenusb.tarIdentification(randomNumber);
if temp='noAnsw' then
begin
ShowMessage('устройство не подключено');
end
else
begin
temp:=copy(temp,4,4);
try
chipherText:=StrToInt('$'+temp);
except
ShowMessage('ничего нет, полный 0');
end;
outText:= tokenusb.decryptBlockFeistel(StrToInt('$'+key),chipherText);
if outText=StrToInt('$'+randomNumber) then
begin
Result:='Устройство опознано';
end
else
Result:='Устройство не опознано';
end;
end
else
begin
ShowMessage('Допускаются');
end;
tokenusb.BComPort1.Close;
end;
exports proverka;
begin
end.
|
| Код |
{тестовая часть с вызовом функции из библиотеки}
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls,DateUtils;
type
TForm1 = class(TForm)
Button1: TButton;
Memo1: TMemo;
Edit1: TEdit;
Edit2: TEdit;
Label1: TLabel;
Label2: TLabel;
Button2: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
function proverka(rand,k: string):string; stdcall;
implementation
{$R *.dfm}
function proverka; external 'sdk.dll' name 'proverka';
function generatorCongruential(initNumber : word):word;
begin
generatorCongruential := ($00AB * initNumber + $2BCD) mod $CF85;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
temp : word;
tyear,tmonth,tday,thour,tmin,tsec,tmsec: word;
rand,rez,k: string;
begin
DecodeDateTime(now,tyear,tmonth,tday,thour,tmin,tsec,tmsec);
temp:= tyear + tmonth + tday + thour + tmin + tsec + tmsec;
temp := generatorCongruential(temp);
Edit1.Text := IntToHex(temp, 4);
rand:=Edit1.Text;
k:=Edit2.Text;
rez:=proverka(rand,k);
form1.Memo1.Lines.Add(rez);
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
Form1.Close;
end;
end.
|
все файлы есть в архиве.
Присоединённый файл ( Кол-во скачиваний: 5 )
FeistelAuthMKSOFT.zip 651,46 Kb |
Перенос кода из *.pas в dll помогите. программирование под контроллер 
Дата 19.5.2012, 22:38 (
Загрузка ...
