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.
На одном компе работал данный код, на другом - не работает. Обращаюсь к разным серверам. Подскажите в чем может быть проблема? Я студент, пытаюсь разобраться в чем косяк, но не пойму с какой стороны к ней подступиться. Спросить тоже некого.
Если можно поточнее, в каком месте не работает...
Да сам бы хотел понять. Запускаю - вываливается ошибка, а как понять откуда она - не понимаю.
Воспользуйтесь отладчиком, чтобы найти место ошибки.
Если вы только запускаете приложение и сразу же ошибка, то искать надо в функциях FormCreate иди FormShow... Криминала пока не вижу... Вы пытаетесь подключиться к COM объекту, а затем к базе данных... Но не сделали обработку возможной ошибки подключения... Проверьте отладчиком - где именно возникает ошибка...
procedure TForm1.Button2Click(Sender: TObject);
begin
ShowObjInfo(strToInt( edit1.text)); - тут
end;
После того, как программа запускается, ввожу ID объекта и кликаю по кнопке Button2. После этого вываливается ошибка.
Ищите ошибку в процедуре procedure ShowObjInfo(id : integer);
Если выложите скрин ошибки, то возможно Вам помогут быстрее.
Скрин залил. В том то и дело что ничего странного в процедуре 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;
Складывается ощущение что программа валится с такой ошибкой при любом действии.
Судя по всему вы пытаетесь работать с двумя разными (физически) базами данных (и заодно через разные сервера приложений). Подозреваю, что по составу БД вроде как должны быть одинаковые (сделано что типа вроде импорта одной БД из другой). Скорее всего при импорте-экспорте идентификаторы вроде как одинаковых объектов изменились чисто физически. В той БД куда вы обращаетесь, просто нет объекта с указанным вами идентификатором. Соответственно и возвращается ошибка. Проверьте штатным клиентом ЛОЦМАНа наличие того объекта, свойства которого вы хотите прочитать и посмотрите его идентификатор, он может отличаться от такого же объекта в другой БД.
А для того, чтобы программа не валилась при ошибке, используйте структуру try ... except end. Любое исключение в рамках данной структуры не будет прерывать выполнение программы и после этого вы можете спокойно отработать сообщение об ошибке...
Цитата: YorikER от 10.09.12, 11:11:01
Судя по всему вы пытаетесь работать с двумя разными (физически) базами данных (и заодно через разные сервера приложений). Подозреваю, что по составу БД вроде как должны быть одинаковые (сделано что типа вроде импорта одной БД из другой). Скорее всего при импорте-экспорте идентификаторы вроде как одинаковых объектов изменились чисто физически. В той БД куда вы обращаетесь, просто нет объекта с указанным вами идентификатором. Соответственно и возвращается ошибка. Проверьте штатным клиентом ЛОЦМАНа наличие того объекта, свойства которого вы хотите прочитать и посмотрите его идентификатор, он может отличаться от такого же объекта в другой БД.
Верно, обращаюсь к разным БД на разных серверах. ID проверял - он точно существует в базе.
Сделайте так:
try
form1.CDS.Data := Lood.GetInfoAboutVersion('', '', '', id, 15, errCode, ErrMes);
except
end;
if errCode<>0 then ShowMessage(ErrMes);
и посмотрите сообщение СП ЛОЦМАНа
С проблемой разобрался. Все было до смешного тупо. Потерял в названии бд одну букву...Спасибо вам за желание оказать помощь.
Удачи! Когда научитесь программировать с использованием методов СП ЛОЦМАНа, увидите насколько ЛОЦМАН - интересная объектно-ориентированная система и сколько возможностей она в себе таит. За ядро ЛОЦМАНа отдельное и огромное спасибо разработчикам... Еще раз удачи...