Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > IT форум > Помощь студентам
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 13.12.2018, 13:37   #1
KBO
Форумчанин
 
Регистрация: 11.06.2010
Сообщений: 525
По умолчанию Delphi - Где находится процедура

Доброе время суток форумчане,
Скачал файл проекта Udf, и саму dll, но оказалась она под х32.
Откомпелировал ее под x64, но оказалась она стала работать не так, что и было предсказуемо
Я как бы нашел место где может быть ошибка, это место

"with BLOb do
PutSegment(Handle, Buffer, ReadLength);" и объявление «TISC_BlobPutSegment» при сохранении файла в blob поле, но я как-то не найду ее код.

Код:
library blobsaveload;

uses
  SysUtils,
  Classes;

{$R *.res}

type

  PInteger  = ^integer;
  PInt      = ^integer;
  Short     = SmallInt;// 16 bit signed
  UShort    = Word;    // 16 bit unsigned
  Long      = LongInt; // 32 bit signed

  TISC_BlobGetSegment = function(BlobHandle: pointer;
                                 Buffer: PChar;
                                 BufferSize: ushort;
                                  var ResultLength: ushort): Short; cdecl;
  TISC_BlobPutSegment = procedure(BlobHandle: pointer;
                                  Buffer: PChar;
                                  BufferLength: Short); cdecl;
  TBlob = record
    GetSegment         : TISC_BlobGetSegment;
    Handle             : pointer;
    SegmentCount       : Long;
    MaxSegmentLength   : Long;
    TotalSize          : Long;
    PutSegment         : TISC_BlobPutSegment;
  end;

  PBlob = ^TBlob;

{
declare external function LoadBLOBFromFile
  cstring(256), blob
returns
  parameter 2
entry_point 'LoadBLOBFromFile'
module_name 'blobsaveload';
}

{
declare external function SaveBLOBToFile
  blob, cstring(256)
returns
  integer by value
entry_point 'SaveBLOBToFile'
module_name 'blobsaveload';
}

function SaveBLOBToFile(var BLOb: TBLOb; FileName: PChar): integer; cdecl; export;
var
  Stream: TFileStream;
  Buffer: PChar;
  EndOfBlob: short;
  MaxBufSize: ushort;
  GotLength: ushort;
begin
  Result:=0;
  try
    if (Assigned(Blob.Handle)) or (Blob.TotalSize > 0) then // don't do anything is blob = 0
      begin
        // add fmShare... option to fmCreate as needed
        Stream := TFileStream.Create(FileName, fmCreate);
        Stream.Seek(0, soFromBeginning);
        MaxBufSize:=Blob.MaxSegmentLength;
        GetMem(Buffer, MaxBufSize + 1);
        try
          repeat
            GotLength := 0; { !?! }

            with BLOb do
              EndOfBLOb := GetSegment(Handle, Buffer, MaxBufSize, GotLength);
            if (GotLength > 0) then {?}
              Stream.WriteBuffer(Buffer^, GotLength);
          until EndOfBLOb = 0;

        finally
          FreeMem(Buffer, MaxBufSize + 1);
          Result:=Stream.Size; // really result need to be int64. but 2 gb blob files is ok.
          Stream.Free;
        end;
      end;
  except
  end;
end;

procedure LoadBLOBFromFile(FileName: PChar; var BLOb: TBLOb); cdecl; export;
const
  MaxBufSize = 8192;
var
  BufSize, ReadLength, StreamSize: Integer;
  Buffer: PChar;
  Stream: TStream;
begin
  try
    Stream := TFileStream.Create(FileName, fmOpenRead or fmShareDenyNone);
    try
      StreamSize := Stream.Size;

      if StreamSize > MaxBufSize then
        BufSize := MaxBufSize
      else
        BufSize := StreamSize;
      GetMem(Buffer, BufSize);
      try
        while StreamSize <> 0 do
          begin
            if StreamSize > BufSize then
              ReadLength := BufSize
            else
              ReadLength := StreamSize;
            Stream.ReadBuffer(Buffer^, ReadLength);

            with BLOb do
              PutSegment(Handle, Buffer, ReadLength);

            Dec(StreamSize, ReadLength);
          end;
      finally
        FreeMem(Buffer, BufSize);
      end;
    finally
      Stream.Free;
    end;
  except
    // do nothing or write error info into initialized log
  end;
end;

// !!! function names in DECLARE EXTERNAL FUNCION ... ENTRY POINT
//     must be SaMe as name specified here
// !!! Function and fUNCTION are different names
exports
 LoadBLOBFromFile,
 SaveBLOBToFile;

begin
  isMultiThread:=True;
end.
Сам первый раз с таким объявлением столкнулся...

Заранее спасибо

Последний раз редактировалось KBO; 13.12.2018 в 17:08.
KBO вне форума Ответить с цитированием
Старый 13.12.2018, 15:31   #2
Pavia
Лис
Старожил
 
Аватар для Pavia
 
Регистрация: 18.09.2015
Сообщений: 2,409
По умолчанию

PChar переименуйте в PAnsiChar.
Хорошо поставленный вопрос это уже половина ответа. | Каков вопрос, таков ответ.
У дзен программиста программа делает то что он хотел, а не то что он написал .
Pavia вне форума Ответить с цитированием
Старый 13.12.2018, 16:47   #3
KBO
Форумчанин
 
Регистрация: 11.06.2010
Сообщений: 525
По умолчанию

Цитата:
Сообщение от Pavia Посмотреть сообщение
PChar переименуйте в PAnsiChar.
Первым делом сделал, и все "SmallInt" и "Word" в "LongInt".
Прослеживаю (F8) до "PutSegment(Handle, Buffer, ReadLength)" и все, что далее не знаю.
KBO вне форума Ответить с цитированием
Старый 13.12.2018, 16:57   #4
p51x
Старожил
 
Регистрация: 15.02.2010
Сообщений: 15,707
По умолчанию

А далее дизасм и в либы базы. TISC_BlobPutSegment определена в IB_Externals.pas, что как бы намекает. Почему не взять https://github.com/madorin/fibplus где прототип уже правильно написан?
p51x вне форума Ответить с цитированием
Старый 13.12.2018, 16:59   #5
Аватар
Старожил
 
Аватар для Аватар
 
Регистрация: 17.11.2010
Сообщений: 18,922
По умолчанию

IB_Externals
Если бы архитекторы строили здания так, как программисты пишут программы, то первый залетевший дятел разрушил бы цивилизацию
Аватар вне форума Ответить с цитированием
Старый 13.12.2018, 17:38   #6
KBO
Форумчанин
 
Регистрация: 11.06.2010
Сообщений: 525
По умолчанию

да, нашел этот "ib_externals.pas" у меня в загашнике за 06.04.1998, сравнил с тем что что на сайте, да, добавились новые типы и некоторые поменялись.

Да типы поменялись в "TISC_BlobPutSegment", но все равно как мне посмотреть, что там в нутри?

Или мне просто нужно потключить скаченный "ib_externals.pas" к библиотеки?..

Вместе с этим модулем, мне пришлось скачать еще:
"FIBPlatforms.pas
FIBPlus.inc
StdFuncs.pas
FIBSafeTimer.pas
FIBConsts.pas
StrUtil.pas
" - надеюсь иду правильным путем...

Последний раз редактировалось KBO; 13.12.2018 в 18:10.
KBO вне форума Ответить с цитированием
Старый 13.12.2018, 18:55   #7
KBO
Форумчанин
 
Регистрация: 11.06.2010
Сообщений: 525
По умолчанию

Откампилировалось, но результат тот же. Может чего не правльно сделал:
1) В моем модуле (пост #1), подключил два модуля "FIBPlatforms" и "StdFuncs,"
2) в моем же модуле, заменил весь блок "type" на сроки из скаченного "ib_externals.pas", т.е.

Код:
 ISC_INT64            = Int64;   { 64 bit signed  }
  Int                  = LongInt; // 32 bit signed

  UInt                 = DWORD;   // 32 bit unsigned
  Long                 = LongInt; // 32 bit signed
  ULong                = DWORD;   // 32 bit unsigned
  Short                = SmallInt;// 16 bit signed
  UShort               = Word;    // 16 bit unsigned
  Float                = Single;  // 32 bit
  UChar                = Byte;    // 8 bit unsigned
  ISC_LONG             = Long;    // 32 bit signed
  UISC_LONG            = ULong;   // 32 bit unsigned
  ISC_BOOLEAN          = SmallInt; { 16 bit signed  }
  {$IFNDEF WIN64}
   ISC_STATUS           = Long;    // 32 bit signed
   UISC_STATUS          = ULong;   // 32 bit unsigned
  {$ELSE}
   ISC_STATUS           = LONG64;    // 64 bit signed
//   UISC_STATUS          = ULONG64;   // 32 bit unsigned
  {$ENDIF}
//  PUISC_STATUS         = ^UISC_STATUS;
  Void                 = Pointer;
  // Delphi "Pointer types"
  PPChar               = ^PAnsiChar;
  PSmallInt            = ^SmallInt;
  PInt                 = ^Int;
  PInteger             = ^Integer;
  PShort               = ^Short;
  PUShort              = ^UShort;
  PLong                = ^Long;
  PULong               = ^ULong;
  PFloat               = ^Float;
  PUChar               = ^UChar;
  PVoid                = ^Pointer;
  PDouble              = ^Double;
  PISC_LONG            = ^ISC_LONG;
  PUISC_LONG           = ^UISC_LONG;
  PISC_STATUS          = ^ISC_STATUS;
  PPISC_STATUS         = ^PISC_STATUS;

  TISC_BlobGetSegment = function(BlobHandle: PInt;
                                 Buffer: PAnsiChar;
                                 BufferSize: Long;
                                 var ResultLength: Long): Short; cdecl;
  TISC_BlobPutSegment = procedure(BlobHandle: PInt;
                                  Buffer: PAnsiChar;
                                  BufferLength: Short); cdecl;
  TBlob = record
    GetSegment         : TISC_BlobGetSegment;
    BlobHandle         : PInt;
    SegmentCount       : Long;
    MaxSegmentLength   : Long;
    TotalSize          : Long;
    PutSegment         : TISC_BlobPutSegment;
  end;
  PBlob = ^TBlob;
3) строку "with BLOb do PutSegment(Handle, Buffer, ReadLength);" в "procedure LoadBLOBFromFile(FileName: PChar;
var BLOb: TBLOb); cdecl; export;
"
на
Код:
with BLOb do PutSegment(BlobHandle, Buffer, ReadLength);
KBO вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц



Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
где находится кэшь WebBrowser? ninja2 Windows Forms 12 12.09.2015 21:20
Где находится компонент TSystemTray? Winexcel Общие вопросы Delphi 12 12.11.2013 22:50
Где находится серийный номер windows xp kreiver Windows 8 06.03.2013 09:22
где находится TPageControl ВалекFCRK Общие вопросы Delphi 4 28.07.2011 23:05
Где находится компонент ТMailMessage? romanzi Работа с сетью в Delphi 0 21.11.2010 11:34