Форум по Delphi программированию

Delphi Sources



Вернуться   Форум по Delphi программированию > Все о Delphi > Программа и интерфейс
Ник
Пароль
Регистрация <<         Правила форума         >> FAQ Пользователи Календарь Поиск Сообщения за сегодня Все разделы прочитаны

Ответ
 
Опции темы Поиск в этой теме Опции просмотра
  #1  
Старый 19.05.2012, 23:50
alexvolnorez alexvolnorez вне форума
Прохожий
 
Регистрация: 19.05.2012
Сообщения: 3
Репутация: 10
По умолчанию Перенос кода из *.pas в dll помогите

Доброго времени суток уважаемые товарищи программисты!
Есть в наличии устройство работающее через 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.

Код:
{Библиотека которую пытаюсь создать}
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.
Вложения
Тип файла: zip FeistelAuthMKSOFT.zip (651.5 Кбайт, 2 просмотров)
Ответить с цитированием
  #2  
Старый 20.05.2012, 03:43
lmikle lmikle вне форума
Модератор
 
Регистрация: 17.04.2008
Сообщения: 8,015
Версия Delphi: 7, XE3, 10.2
Репутация: 49089
По умолчанию

в архиве не смотрел, но выложенный в сообщении код портирован просто безобразно. Вообще, странно, что он собрался. Видимо end'ы добавлялись по мере необходимости для того, что бы хоть как-то собралось.

в общем, надо садиться, разбираться как оно должно работать и переписывать библиотеку полностью. К сожалению, для отладки нужно иметь "железку"...
Ответить с цитированием
  #3  
Старый 20.05.2012, 12:33
alexvolnorez alexvolnorez вне форума
Прохожий
 
Регистрация: 19.05.2012
Сообщения: 3
Репутация: 10
По умолчанию

А есть какие то программки, эмуляторы COM-port, Вчера удалось дойти до места куда программа заходит но ничего в нем не делает. Вот код дополнительного модуля из которого библиотека берет функции.

procedure TtokenUsb.Timer1Timer(Sender: TObject);
процедура по обращению к которой ничего не происходит. Но только при работе через библиотеку
код во вложенном файле не поместился сюда
Вложения
Тип файла: txt usbToken.txt (10.0 Кбайт, 5 просмотров)
Ответить с цитированием
  #4  
Старый 20.05.2012, 13:32
Аватар для cotseec
cotseec cotseec вне форума
Активный
 
Регистрация: 16.07.2008
Сообщения: 353
Версия Delphi: D7,TDE06,RAD09
Репутация: 1443
По умолчанию

Цитата:
А есть какие то программки, эмуляторы COM-port
при разработке и изучении работы довольно неплохо помогает Free Serial Port Monitor
также еще пригодится что-нибудь из серии null modem emulator
Полный джентльменский набор
__________________
Понять, что хочет заказчик - бесценно, ведь он платит MasterCard
Ответить с цитированием
  #5  
Старый 20.05.2012, 20:40
alexvolnorez alexvolnorez вне форума
Прохожий
 
Регистрация: 19.05.2012
Сообщения: 3
Репутация: 10
По умолчанию

Порт монитор у меня есть, но в нем не видно почему не приходят ответы от устройства. А вот за вторую программку спасибо, буду разбираться.

Да вот еще попытался создать функцию инициализации компонента BComPort программным способом в библиотеке создался а вот при вызове закрывает вызывающую программу.
Код:
function InitCOM(PortNum: string): ShortInt; Export;
begin
  Result:= -1;
  try
    CP:= TBComPort.Create(nil);
    with CP do begin
      BaudRate:= br9600;
      ByteSize:= bs8;
      CTPriority:= tpNormal;
      InBufSize:= 2048;
      OutBufSize:= 2048;
      Parity:= paNone;
      Port:=(PortNum);
      StopBits:= sb1;
      SyncMethod:= smThreadSync;
      Timeouts.ReadInterval:= -1;
      Timeouts.ReadTotalMultiplier:= 0;
      Timeouts.ReadTotalConstant:= 150; //150ms //5000; //5sec
      Timeouts.WriteTotalMultiplier:= 100;
      Timeouts.WriteTotalConstant:= 1000;

      Open;
    end;
    Result:= 0;
  except
    Result:= -1;
  end;
end;
Ответить с цитированием
Ответ


Delphi Sources

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск
Опции просмотра

Ваши права в разделе
Вы не можете создавать темы
Вы не можете отвечать на сообщения
Вы не можете прикреплять файлы
Вы не можете редактировать сообщения

BB-коды Вкл.
Смайлы Вкл.
[IMG] код Вкл.
HTML код Выкл.
Быстрый переход


Часовой пояс GMT +3, время: 07:45.


 

Сайт

Форум

FAQ

RSS лента

Прочее

 

Copyright © Форум "Delphi Sources" by BrokenByte Software, 2004-2023

ВКонтакте   Facebook   Twitter