EDatabaseError "Invalid data packet"

[bibit]

Код Выделить Развернуть

unit Unit1;

interface

uses
  LoodsmanServerApplication_TLB, ComObj, ActiveX, PIClasses,

  ShellApi,
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls, DB, DBClient, Grids, DBGrids, ADODB;

const
  ServerName = 'UNICORN'; // ??? ???????, ??? ????? ??????
  BaseName = 'VirtualYstu';      // ??? ???? ?????? ???????

type
  TForm1 = class(TForm)
    bttnGetStructure: TButton;
    Edit1: TEdit;
    Panel1: TPanel;
    CDS: TClientDataSet;
    Button2: TButton;
    bttnFiles: TButton;
    ListBox1: TListBox;
    Panel2: TPanel;
    Panel3: TPanel;
    Image1: TImage;
    Button1: TButton;
    Button3: TButton;
    Button4: TButton;
    Memo1: TMemo;
    procedure bttnGetStructureClick(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure bttnFilesClick(Sender: TObject);
    procedure ListBox1DblClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure CopyFileTo(FName, OutFName: string);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
  private
    { Private declarations }
  public
    isLood : boolean;

    CheckOutName : string;
    FN : string;

    procedure Init;
    { Public declarations }
  end;

var
  Form1: TForm1;
  Lood : IMainSystem;
   RM: TRunMethod;
implementation

{$R *.dfm}

procedure CreateLood(var Lood_ : IMainSystem);
var
  unc: IUnknown;
  g: TGUID;
  errCode, ErrMes : OleVariant;
  lvl : integer;
begin
////////////////////////////////////////////////////////////////////////////////
// ?????? ??? ?????? ?????????????
  if Win32Platform = VER_PLATFORM_WIN32_NT
  then lvl := 4
  else lvl := 3;
  OleCheck(CoInitializeSecurity(nil, -1, nil, nil, 1, lvl, nil, $0, nil));
////////////////////////////////////////////////////////////////////////////////

  g := CLASS_MainSystem;
  unc := CreateRemoteComObject(ServerName, g);
  if unc.QueryInterface(IMainSystem, Lood_) <> S_OK then MessageDlg('?? ??????? ????????????', mtError, [mbOk], 0);

end;

procedure TForm1.Init;
var
  errCode, ErrMes : OleVariant;
begin
  CreateLood(Lood);
  Lood.ConnectToDB(BaseName, errCode, ErrMes);
end;


// ???????? TPV ??????? ?? id
procedure ShowObjInfo(id : integer);
var
  st : string;
  errCode, ErrMes : OleVariant;
begin
  if Form1.isLood
  then form1.CDS.Data := Lood.GetInfoAboutVersion('', '', '', id, 15, errCode, ErrMes)
  else Form1.CDS.Data := RM('GetInfoAboutVersion', ['', '', '', id, 15]);

  form1.CDS.First;
  st := '';
  st := st + #13 + form1.CDS.FieldByName('_TYPE').AsString;
  st := st + #13 + form1.CDS.FieldByName('_PRODUCT').AsString;
  st := st + #13 + form1.CDS.FieldByName('_VERSION').AsString;
  st := st + #13 + form1.CDS.FieldByName('_STATE').AsString;
  showMessage(st);
end;

// ???????? ?????? ???????
procedure TForm1.bttnGetStructureClick(Sender: TObject);
var
  st : string;
  errCode, ErrMes : OleVariant;
  id : integer;
begin
  id := strtoint(edit1.Text);
  // ???????? ????????????? ???????, ??? ?????, ?????? ??? ???????? ?????
  if Form1.isLood
  then CDS.Data := Lood.GetLinkedFast(id, '??????? ?? ...', false, errCode, ErrMes)
  else CDS.Data := RM('GetLinkedFast', [id, '??????? ?? ...', false]);

  if errCode <> 0 then ShowMessage(VarToStr(ErrMes));

  CDS.First;
  memo1.Lines.Clear;
  while not CDS.Eof do
  begin
    memo1.Lines.Add(cds.FieldByName('_ID_VERSION').AsString);
    CDS.Next;
  end;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  ShowObjInfo(strToInt( edit1.text));
end;

procedure TForm1.bttnFilesClick(Sender: TObject);
var
  id : integer;
  errCode, ErrMes : OleVariant;
begin
  id := strtoint(edit1.Text);
  if Form1.isLood
  then CDS.Data := Lood.GetInfoAboutVersion('', '', '', id, 7, errCode, ErrMes)
  else CDS.Data := RM('GetInfoAboutVersion', ['', '', '', id, 7]);

  CDS.First;
  ListBox1.Items.Clear;
  while not CDS.Eof do
  begin
    ListBox1.Items.Add(edit1.Text + '=' + CDS.FieldByName('_NAME').AsString + '=' + CDS.FieldByName('_LOCALNAME').AsString);
    CDS.Next;
  end;
end;


procedure TForm1.CopyFileTo(FName, OutFName: string);
var
    errCode, errMess: OleVariant;
    arr: array of byte;
    v: Variant;
    BlockSize, CRC: OleVariant;
    FileSize: integer;
    OutSize: OleVariant;

    fs: TFileStream;
begin
  // ???????? ?????? ?????
  CDS.Data := lood.GetInfoAboutFile(FName, '', errCode, errMess);

  CDS.First;
  FileSize := CDS.FieldByName('_SIZE').AsInteger;

  SetLength(arr, FileSize);

  if Form1.isLood then
    v := lood.GetFileData(FName, '', 0, FileSize, 0, OutSize, BlockSize, CRC, errCode, errMess)
  else v := RM('GetFileData', [FName, '', 0, FileSize, 0, OutSize, BlockSize, CRC]);

  if errCode = 0 then
  begin
    arr := v;
    fs := TFileStream.Create(OutFName, fmCreate);
    try
      fs.Write(arr[0], FileSize);
    finally
      fs.Free;
    end; // of try
  end;
end;


procedure TForm1.ListBox1DblClick(Sender: TObject);
var
  strs : TStringList;
  i : integer;
  ext : string;
  errCode, ErrMes : OleVariant;
begin
  strs := TStringList.Create;
  try
    i := ListBox1.ItemIndex;
    if i < 0 then exit;
    strs.Text := StringReplace(ListBox1.Items[i], '=', #13, [rfReplaceAll]);
    if strs.Count < 3 then strs.Add('');

    if isLood
    then FN := Lood.ExtractFile('', '', '',  StrToInt(strs[0]), strs[1], strs[2], 0, errCode, ErrMes)
    else FN := RM('ExtractFile' , ['', '', '',  StrToInt(strs[0]), strs[1], strs[2], 0]);


    ext := ExtractFileExt(FN);
    if ext = '.bmp' then Image1.Picture.LoadFromFile(fn)
    else ShellExecute(0, 'open', pchar(FN), '', '', SW_NORMAL);

  finally
    strs.Free;
  end;
end;


procedure TForm1.FormShow(Sender: TObject);
begin
  if isLood then init;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  isLood := true;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  id : integer;
  t, p, v : string;
  FN, LFN : string;
  errCode, ErrMes : OleVariant;
begin
  id := strToInt(edit1.text);
  CheckOutName := lood.CheckOut('', '', '', 0, errCode, ErrMes);
  Lood.ConnectToCheckOut(CheckOutName, lood.CurrentBase, errCode, ErrMes);
  Lood.AddToCheckOut(id, true, errCode, ErrMes);

  CDS.Data := lood.GetInfoAboutVersion('', '', '', id, 15, errCode, ErrMes);
  CDS.First;

  t := CDS.FieldByName('_TYPE').AsString;
  p := CDS.FieldByName('_PRODUCT').AsString;
  v := CDS.FieldByName('_VERSION').AsString;


  CDS.Data := lood.GetInfoAboutVersionsFiles(inttostr(id), errCode, ErrMes);
  CDS.First;
  FN := CDS.FieldByName('_NAME').AsString;
  LFN := CDS.FieldByName('_LOCALNAME').AsString;

  fn := lood.GetFile(t, p, v, fn, lfn, errCode, ErrMes);

  ShellExecute(0, 'open', pchar(fn), '', '', SW_NORMAL);

end;

procedure TForm1.Button3Click(Sender: TObject);
var
  strs : TStringList;
  i : integer;
  ext : string;
  errCode, ErrMes : OleVariant;
begin
  strs := TStringList.Create;
  try
    i := ListBox1.ItemIndex;
    if i < 0 then exit;
    strs.Text := StringReplace(ListBox1.Items[i], '=', #13, [rfReplaceAll]);
    if strs.Count < 3 then strs.Add('');
    CopyFileTo(strs[1], 'D:\'+strs[1]);
  finally
    strs.Free;
  end;
end;

procedure TForm1.Button4Click(Sender: TObject);
var
  errCode, ErrMes : OleVariant;
begin
  case MessageDlg('????? ??????? ??????? Yes,'#13'????? ?????????? ??????? No', mtCustom, mbYesNoCancel, 0) of
    mrYes : Lood.CheckIn(CheckOutName, lood.CurrentBase, errCode, ErrMes);
    mrNo  : Lood.CancelCheckOut(CheckOutName, lood.CurrentBase, errCode, ErrMes);
  else exit;
  end;

  Lood.DisconnectCheckOut(CheckOutName, lood.CurrentBase, errCode, ErrMes);
end;

end.

На одном компе работал данный код, на другом - не работает. Обращаюсь к разным серверам. Подскажите в чем может быть проблема? Я студент, пытаюсь разобраться в чем косяк, но не пойму с какой стороны к ней подступиться. Спросить тоже некого.

[YorikER]

Если можно поточнее, в каком месте не работает...

[bibit]

Да сам бы хотел понять. Запускаю - вываливается ошибка, а как понять откуда она - не понимаю.

[Sabahs]

Воспользуйтесь отладчиком, чтобы найти место ошибки.

[YorikER]

Если вы только запускаете приложение и сразу же ошибка, то искать надо в функциях FormCreate иди FormShow... Криминала пока не вижу... Вы пытаетесь подключиться к COM объекту, а затем к базе данных... Но не сделали обработку возможной ошибки подключения... Проверьте отладчиком - где именно возникает ошибка...

[bibit]

Код Выделить Развернуть

procedure TForm1.Button2Click(Sender: TObject);
begin
  ShowObjInfo(strToInt( edit1.text)); - тут
end;
После того, как программа запускается, ввожу ID объекта и кликаю по кнопке Button2. После этого вываливается ошибка.

[Sabahs]

Ищите ошибку в процедуре procedure ShowObjInfo(id : integer);
Если выложите скрин ошибки, то возможно Вам помогут быстрее.

[bibit]

Скрин залил. В том то и дело что ничего странного в процедуре ShowObjInfo не вижу. Мало того, в другой сети этот код работал нормально, а тут не хочет
ShowObjInfo:

Код Выделить Развернуть

procedure ShowObjInfo(id : integer);
var
  st : string;
  errCode, ErrMes : OleVariant;
begin
  if Form1.isLood
  then form1.CDS.Data := Lood.GetInfoAboutVersion('', '', '', id, 15, errCode, ErrMes)
  else Form1.CDS.Data := RM('GetInfoAboutVersion', ['', '', '', id, 15]);

  form1.CDS.First;
  st := '';
  st := st + #13 + form1.CDS.FieldByName('_TYPE').AsString;
  st := st + #13 + form1.CDS.FieldByName('_PRODUCT').AsString;
  st := st + #13 + form1.CDS.FieldByName('_VERSION').AsString;
  st := st + #13 + form1.CDS.FieldByName('_STATE').AsString;
  showMessage(st);
end;
Складывается ощущение что программа валится с такой ошибкой при любом действии.

[YorikER]

 Судя по всему вы пытаетесь работать с двумя разными (физически) базами данных (и заодно через разные сервера приложений). Подозреваю, что по составу БД вроде как должны быть одинаковые (сделано что типа вроде импорта одной БД из другой). Скорее всего при импорте-экспорте идентификаторы вроде как одинаковых объектов изменились чисто физически. В той БД куда вы обращаетесь, просто нет объекта с указанным вами идентификатором. Соответственно и возвращается ошибка. Проверьте штатным клиентом ЛОЦМАНа наличие того объекта, свойства которого вы хотите прочитать и посмотрите его идентификатор, он может отличаться от такого же объекта в другой БД.

[YorikER]

А для того, чтобы программа не валилась при ошибке, используйте структуру try ... except end. Любое исключение в рамках данной структуры не будет прерывать выполнение программы и после этого вы можете спокойно отработать сообщение об ошибке...

[bibit]

Судя по всему вы пытаетесь работать с двумя разными (физически) базами данных (и заодно через разные сервера приложений). Подозреваю, что по составу БД вроде как должны быть одинаковые (сделано что типа вроде импорта одной БД из другой). Скорее всего при импорте-экспорте идентификаторы вроде как одинаковых объектов изменились чисто физически. В той БД куда вы обращаетесь, просто нет объекта с указанным вами идентификатором. Соответственно и возвращается ошибка. Проверьте штатным клиентом ЛОЦМАНа наличие того объекта, свойства которого вы хотите прочитать и посмотрите его идентификатор, он может отличаться от такого же объекта в другой БД.

Верно, обращаюсь к разным БД на разных серверах. ID проверял - он точно существует в базе.

[YorikER]

Сделайте так:

try
  form1.CDS.Data := Lood.GetInfoAboutVersion('', '', '', id, 15, errCode, ErrMes);
except
end;
if errCode<>0 then ShowMessage(ErrMes);

и посмотрите сообщение СП ЛОЦМАНа

[bibit]

С проблемой разобрался. Все было до смешного тупо. Потерял в названии бд одну букву...Спасибо вам за желание оказать помощь.

[YorikER]

Удачи! Когда научитесь программировать с использованием методов СП ЛОЦМАНа, увидите насколько ЛОЦМАН - интересная объектно-ориентированная система и сколько возможностей она в себе таит. За ядро ЛОЦМАНа отдельное и огромное спасибо разработчикам... Еще раз удачи...