Delphi assignfile ошибка

It is not AssignFile() that fails, but your call to Rewrite() on a file with the Hidden attribute set. Following explains it:

Typically you call Rewrite(F) in order to erase the file and write new data to it with subsequent Write(F, ...) or WriteLn(F, ...) calls.

From docs (System.Rewrite):

If an external file with the same name already exists, it is deleted
and a new empty file is created in its place.

There is no problem opening the file for writing with the Append() command.

(Based on above I drew the conclusion that it is the deletion that fails with the Access denied message. That was cutting the corners too much.)

Beaten by comments I traced through the code and compared actual code with MSDN documentation for CreateFile:

Actual code:

// if mode is fmOutput (as it is for Rewrite)
OpenMode = GENERIC_WRITE
Flags = CREATE_ALWAYS
// ...
Temp := CreateFile(t.Name, OpenMode, FILE_SHARE_READ, nil, Flags, FILE_ATTRIBUTE_NORMAL, 0);

And documentation:

If CREATE_ALWAYS and FILE_ATTRIBUTE_NORMAL are specified, CreateFile
fails and sets the last error to ERROR_ACCESS_DENIED if the file
exists and has the FILE_ATTRIBUTE_HIDDEN or FILE_ATTRIBUTE_SYSTEM
attribute.

Calling Rewrite() on a existing file with the hidden attribute fails always.

Puporev, сижу с температурой и решил перебить код ручками…. и слегка опечатался (:wall:), в коде программы — append, а не Reset (проверил только что).

Менять append на rewrite — тоже пробовал, это первое что пришло мне в голову, но увы — ничего на изменилось, ошибка сохранялась.

Код из программы:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36

procedure TForm2.Button1Click(Sender: TObject);
var
wtf : TextFile;
UserName, result : string;
UserNameLen : Dword;
begin
i:=i+1;
if i=1 then  begin
Memo1.Lines.Add(inttostr(i));
if fileexists('kurs.txt') then Memo1.Lines.Add('Файл экзист')
else Memo1.Lines.Add('Файл вообще не экзист');
end;
if i=2 then  begin
Memo1.Lines.Add(inttostr(i));
AssignFile(wtf,'kurs.txt');
Memo1.Lines.Add('Файл связан');
end;
if i=3 then  begin
Memo1.Lines.Add(inttostr(i));
Append(wtf); // Не важно что тут Rewrite или Append - ошибка сохраняется
Memo1.Lines.Add('Открыт для записи');
end;
if i=4 then  begin
UserNameLen := 255;
SetLength(userName, UserNameLen);
if GetUserName(PChar(UserName), UserNameLen) then Result := Copy(UserName,1,UserNameLen - 1)
else Result := 'Unknown';
WriteLn(wtf, Result);
Memo1.Lines.Add('Строка записана');
end;
if i=5 then  begin
Memo1.Lines.Add(inttostr(i));
CloseFile(wtf);
Memo1.Lines.Add('Файл Закрыт');
end;
end;

northener — точно… я же Button жму… глупая ошибка, всё от лени и нежелания проходить полный путь от запуска основной программы до выполнения ею записи в файл, сейчас уберу if then и посмотрю что отладчик пишет в переменную, по результатам отпишусь

Добавлено через 27 минут
Я прям даже не знаю, что и сказать… Ну проблему устранил и она была и близко не в AssignFile/Append и пр. …

После подсказки господина nortenerа — всё заработало на XP и я решил проверить основную программу, и там есть стадия, когда происходит перебор всех файлов и папок (с её подпапками) в заданной директории, с целью найти файлик с определённым расширением… Для простоты манипуляций я выполнял SetCurrentDir(ExtractFileDir(ptor)) (в ptor как раз записан адрес директории, в которой ищет программа)… А вот вернуть всё на место — я подзабыл…

В итоге — проблема была всё же в том, что файла не было в той директории, откуда он доставался и само собой банальный SetCurrentDir(ExtractFilePath(ParamStr(0))) — меня спас и всё теперь по фэншую:)
А тот факт, что сработало на Windows 7 и не сработало на Windows XP — банально не повезло, на Windows 7 я не прогонял программу по всем функциям за один запуск, а на Windows XP — одно и тоже запущенное приложение прогнал по всем возможностям его, в результате на одном из этапов директория сбивалась и связать переменную с несуществующим файлом — было уже никому не под силу

Тему закрывать могу как-то сам, или надо как-то попросить модераторов?

← →
Сергей
 
(2002-12-25 20:39)
[0]

← →
Rouse_
 
(2002-12-25 20:45)
[1]

← →
Сергей
 
(2002-12-25 20:52)
[2]

← →
Morfein
 
(2002-12-25 21:03)
[3]

А может у тебя действительно файла нету? %))

А если есть, то зачем ты привязался к этому методу?… Чё, WinAPI теперь не в моде?

CreateFile или открывает иили создаёт файл, или тестирует его наличие… быстро, выгодно, удобно!

← →
Сергей
 
(2002-12-25 21:07)
[4]

Дык, сделать то все можно, только это вопрос времени (сколько его уйдет на хелпы по API, c учетом того, что пользую я его весьма ограничено). И ваще, вопрос принципиальный… Глюк ето неописанный или я дурак (второе конечно вероятней)

← →
Rouse_
 
(2002-12-25 21:15)
[5]

← →
Morfein
 
(2002-12-25 21:16)
[6]

Ты не ответил, есть ли у тебя файл… А вообще, пришли прогу на мыло… мож чего скажу

← →
Сергей
 
(2002-12-25 21:27)
[7]

файла нет. Он должен создаваться после вызова Rewrite. Указанный путь существует. А прогу целиком слать — мазы нет, так много кб Ж)

← →
Morfein
 
(2002-12-25 21:30)
[8]

Ну как знаешь %))

← →
Anatoly Podgoretsky
 
(2002-12-25 21:30)
[9]

Ты пишешь «Если я выдираю упомянутую форму из проекта и тестирую ее как отдельное приложение с созданием копии класса при запуске — все нормально.» — это говорит о том, что проблема у тебя в другом месте.

Возможно переопределен AssignFile мли Rewrite

← →
gsu
 
(2002-12-25 21:32)
[10]

← →
Сергей
 
(2002-12-25 21:39)
[11]

← →
gsu
 
(2002-12-25 21:44)
[12]

← →
Anatoly Podgoretsky
 
(2002-12-25 21:44)
[13]

← →
Anatoly Podgoretsky
 
(2002-12-25 21:45)
[14]

Кроме того попробуй создать файл «C:\temp\test.txt» из проводника

← →
gsu
 
(2002-12-25 21:46)
[15]

>> Anatoly Podgoretsky © (25.12.02 21:44)

>> Чудес же не бывает.

Бывают, но не в математике

← →
Сергей
 
(2002-12-25 21:51)
[16]

← →
Сергей
 
(2002-12-25 21:54)
[17]

Файл тестовый из проводника создается. system.pas на диске в единственном экземпляре, и обращение напрямую system.rewrite не помогает Ето все я уже долбал.

← →
Anatoly Podgoretsky
 
(2002-12-25 21:57)
[18]

← →
Сергей
 
(2002-12-25 21:59)
[19]

Результат тот же. Может Дельфа мусором поросла? Я тут недавно компоненты смотрел, модет они напоганили чего? Переинсталить ее…

← →
Anatoly Podgoretsky
 
(2002-12-25 22:01)
[20]

Да и system.pas не интересует, интеренсует только system.dcu

← →
Сергей
 
(2002-12-25 22:04)
[21]

system.dcu в единственном экземпляре. А что там — только дельфи знает Бэкапов вроде не наблюдается.

← →
Сергей
 
(2002-12-25 22:07)
[22]

← →
Song
 
(2002-12-25 23:24)
[23]

Такое бывает когда предыдуще открытый такого же типа файл не закроешь, а потом снова делаешь ReWrite(), и прчём здесь уже похрену, какая это переменная локальная или глобальная.

← →
PVOzerski
 
(2002-12-26 00:17)
[24]

IMHO, либо ошибка совсем нелепая (например, нет на самом деле каталога c:\temp), либо

где-то происходит несанкционированное перекрытие строковой или файловой переменной

с «забиванием» его содержимого из-за некоррекной работы с индексами, динамической

памятью и т.п. или даже глюка компилятора. Попробуйте-ка посмотреть содержимое

файловой переменной в момент rewrite — то ли там имя. Внутреннее представление

структуры поищите в исходниках RTL, наверняка можно обойтись приведением

типов (во FreePascal есть TextRec и FileRec, наверняка подобное есть и в Delphi).

← →
icWasya
 
(2002-12-26 10:23)
[25]

а втом примере что приведён нет CoseFile

← →
gsu
 
(2002-12-26 10:28)
[26]

Да, да может понаоткрывал, а не закрывал и комп обиделся, грузанись.

А на счет в какой ты форме открываешь, это по фигу, если она создана и работоспособна

← →
Anatoly Podgoretsky
 
(2002-12-26 10:38)
[27]

← →
gsu
 
(2002-12-26 10:50)
[28]

угу, все хренова оптимизация

← →
Каспер
 
(2002-12-26 11:04)
[29]

Все таки интересно чем это закончится.

Мне так интитивно кажется что файл уже занят чем то.

Давай выведи на экран IOResult… предварительно отрубив {$I-}…

← →
Song
 
(2002-12-26 11:21)
[30]

Я уже сказал в чём проблема..

← →
Каспер
 
(2002-12-26 11:26)
[31]

Так все решилось? И все таки интересно что выдал ИОРезулт

← →
Сергей
 
(2002-12-26 13:08)
[32]

← →
Каспер
 
(2002-12-26 14:04)
[33]

Сорри Но точно там стоит AssignFile а не Assign?

← →
Жорик
 
(2002-12-26 14:19)
[34]

← →
gsu
 
(2002-12-26 16:03)
[35]

>> TStringList.SaveToFile(«path»)

героическое решение …

← →
Alexander1966
 
(2002-12-27 15:28)
[36]

А диск точно c: СИ, может c: ЭС. Бывает.

unit MainProfile;

interface

uses

  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

  Dialogs, StdCtrls, ExtCtrls, IniFiles, AdPacket, OoMisc, AdPort, Grids,

  Mask;

type

  TfrmProfile = class(TForm)

    btnSeting: TButton;

    btnForward: TButton;

    btnBack: TButton;

    btnExit: TButton;

    lblHelp: TLabel;

    Bevel1: TBevel;

    Bevel2: TBevel;

    prtOLD: TApdComPort;

    dpktOLD: TApdDataPacket;

    pnlMode: TPanel;

    rbtnWork: TRadioButton;

    rbtnTest: TRadioButton;

    pnlWork: TPanel;

    rbtnCheckWrite: TRadioButton;

    rbtnDateRead: TRadioButton;

    Label2: TLabel;

    Label3: TLabel;

    Label4: TLabel;

    Label5: TLabel;

    edtOperator: TEdit;

    cmbxQuantityZond: TComboBox;

    edtCountRead: TEdit;

    edtDate: TEdit;

    pnlReadCodes: TPanel;

    Label1: TLabel;

    Label6: TLabel;

    Label8: TLabel;

    Label9: TLabel;

    StaticText1: TStaticText;

    StaticText2: TStaticText;

    ApdComPort1: TApdComPort;

    Label10: TLabel;

    pnlReadInformation: TPanel;

    Label11: TLabel;

    lblFactoryNumber: TStaticText;

    pnlEnterStartDataSounding: TPanel;

    StrgrdEnterStartDataSounding: TStringGrid;

    lblCount: TStaticText;

    lblkodIKD: TStaticText;

    lblkodIKT: TStaticText;

    lblkodIKP: TStaticText;

    StrgrdReadInformation: TStringGrid;

    MaskEdit1: TMaskEdit;

    Button1: TButton;

    procedure btnExitClick(Sender: TObject);

    procedure FormShow(Sender: TObject);

    procedure rbtnWorkClick(Sender: TObject);

    procedure btnForwardClick(Sender: TObject);

    procedure btnSetingClick(Sender: TObject);

    procedure dpktOLDPacket(Sender: TObject; Data: Pointer; Size: Integer);

    procedure rbtnCheckWriteClick(Sender: TObject);

    procedure StrgrdEnterStartDataSoundingGetEditMask(Sender: TObject; ACol, ARow: Integer;

      var Value: String);

    procedure FormClose(Sender: TObject; var Action: TCloseAction);

    procedure StrgrdEnterStartDataSoundingSetEditText(Sender: TObject;

      ACol, ARow: Integer; const Value: String);

  private

    procedure GetIni;

    { Private declarations }

  public

    { Public declarations }

  end;

var

  frmProfile: TfrmProfile;

  OperatingCondition:boolean=true;//true — «Работа с ПУ»/false — «Тестирование ПУ»

  CheckWriteMode:boolean=true;//true — «Подготовка к зондированию»/false — «Прием записанной информации»

  CounterStaffs: integer=0;//счетчик кадров

  CounterHeadings: integer=0;//счетчик заголовков

  CounterEndInformation: integer=0;//счетик конца информационного массива

  Headings:boolean=true;

implementation

{$R *.dfm}

 //запись в ini файл  и установка параметров

{procedure SaveIni;

var

  IniFile: TIniFile;

begin

  IniFile := TIniFile.Create(ExtractFilePath(Application.Exename) + ‘Meteo.ini’);

  ////////Запись Настроек порта PTB200///////////////////

  if DataModulePTB.PTB_Port.Open

  then iniFile.Writeinteger(‘Parametrs PTB200’, ‘COM Number’, DataModulePTB.PTB_Port.ComNumber)

  else iniFile.Writeinteger(‘Parametrs PTB200’, ‘COM Number’, 0);

  IniFile.WriteInteger(‘Parametrs PTB200’, ‘Baud’, DataModulePTB.PTB_Port.Baud);

  IniFile.WriteInteger(‘Parametrs PTB200’, ‘DataBits’, DataModulePTB.PTB_Port.DataBits);

  IniFile.Writeinteger(‘Parametrs PTB200’, ‘parity’, frmSet.CBPTBparity.ItemIndex);

  IniFile.WriteInteger(‘Parametrs PTB200’, ‘StopBits’, DataModulePTB.PTB_Port.StopBits);

  IniFile.WriteString(‘Parametrs PTB200’, ‘TimeOut’, frmSet.medtTimeOutPTB.Text );

  IniFile.WriteString(‘Parametrs PTB200’, ‘Altitude’, frmMeteo.lblAltitude.Caption);

  IniFile.Free;

end;

  }

////////////////////////////////////////////////////////////////////////////////

// чтение из ini файла и установка параметров

procedure TfrmProfile.GetIni;

var

  IniFile: TIniFile;

  strQuantityOLD:string;

begin

  IniFile := TIniFile.Create(ExtractFilePath(Application.Exename)+ ‘Profile.ini’);

  //Выдача Номера порта///////////////////

  if IniFile.Readinteger(‘Seting’, ‘Port Number’, 1)<>0

  then

    try

      prtOLD.ComNumber:=IniFile.Readinteger(‘Seting’, ‘Port Number’, 1);

      PrtOLD.Open:=true;

    except

      PrtOLD.Open:=false;

      PrtOLD.ComNumber:=0;

    end;

 //Чтение Поля Operator//////////////////////

 frmProfile.edtOperator.Text:=IniFile.Readstring(‘Seting’, ‘Operator’, ‘Оператор’);

 //Чтение поля Instrumens//////////////////////

 if Pos(‘,’, IniFile.Readstring(‘Seting’, ‘Instrumens’, »))=0

 then frmProfile.cmbxQuantityZond.Text:=IniFile.Readstring(‘Seting’, ‘Instrumens’, »)

 else

   begin

     strQuantityOLD:=IniFile.Readstring(‘Seting’, ‘Instrumens’, »)+’,’;

     while Pos(‘,’, strQuantityOLD) > 0 do

       begin

         frmProfile.cmbxQuantityZond.Items.Add(copy(strQuantityOLD,1,Pos(‘,’, strQuantityOLD)-1));

         Delete(strQuantityOLD,1,Pos(‘,’,strQuantityOLD));

       end;

     frmProfile.cmbxQuantityZond.ItemIndex:=0;

   end;

  IniFile.Free;

end;

procedure TfrmProfile.btnExitClick(Sender: TObject);

begin

 Close;

end;

procedure TfrmProfile.FormShow(Sender: TObject);

begin

  edtDate.Text:=dateTostr(now);

  GetIni;

end;

procedure TfrmProfile.rbtnWorkClick(Sender: TObject);

begin

  cmbxQuantityZond.Enabled:=rbtnWork.Checked;

  Label4.Enabled:=rbtnWork.Checked;

  //Если работа то true

  OperatingCondition:=rbtnWork.Checked;

end;

procedure TfrmProfile.btnForwardClick(Sender: TObject);

var   F1: file of byte;

begin

  if btnForward.Focused

  then frmProfile.Tag:=frmProfile.Tag+1

  else frmProfile.Tag:=frmProfile.Tag-1;

  Label10.Caption:=inttostr(frmProfile.Tag);

  case frmProfile.Tag of

   0: begin

      //Панель выбора режима работы. «Тестирование ПУ» или «Работа с ПУ»

        Caption:=’ПРОФИЛЬ 2006 — Выбор режима работы’;

        lblHelp.Caption:=’Выбирите режим работы с погружным устройством. Произведите заполнение всех полей. Проверте текущие установки станции и погружного устройства.’;

        pnlMode.BringToFront;

        btnBack.Enabled:=false;

      end;

   1: begin

      // Если выбрано «Работа с ПУ» то OperatingCondition=true

        if OperatingCondition then

          begin

            Caption:=’ПРОФИЛЬ 2006 — Работа с ПУ’;

            lblHelp.Caption:=’Выбирите один из 2-х режимов. ПОДГОТОВКА К ЗОНДИРОВАНИЮ или ПРИЕМ ЗАПИСАННЙ ИНФОРМАЦИИ.’;

            pnlWork.BringToFront;

          end

        else

          begin

            Caption:=’ПРОФИЛЬ 2006 — Прием текущих кодов’;

            lblHelp.Caption:=’Установите герметичный переключатель режимов погружного устройства в положение «К». Для окончания приема текущих кодов нажмите любую клавишу.’;

            pnlReadCodes.BringToFront;

            //Иницализация пакета

            dpktOLD.Enabled:=false;

            dpktOLD.StartString:=#0+’ж’;

            dpktOLD.Enabled:=true;

            //Очистка всех окон на панели pnlReadCodes

            lblCount.Caption:=»;

            lblkodIKP.Caption:=»;

            lblkodIKT.Caption:=»;

            lblkodIKD.Caption:=»;

            //сброс счетчиков заголовков и кадров

            CounterStaffs:=0;

            CounterHeadings:=0;

            //заголовок не читать

            Headings:=false;

          end;

        btnBack.Enabled:=true;

      end;

   2: begin

        if CheckWriteMode then

          begin

            Caption:=’ПРОФИЛЬ 2006 — Прием текущих кодов’;

            lblHelp.Caption:=’Установите герметичный переключатель режимов погружного устройства в положение «К».’;

            pnlReadCodes.BringToFront;

            //Иницализация пакета

            dpktOLD.Enabled:=false;

            dpktOLD.StartString:=#0+’ж’;

            dpktOLD.Enabled:=true;

            //Очистка всех окон на панели pnlReadCodes

            lblCount.Caption:=»;

            lblkodIKP.Caption:=»;

            lblkodIKT.Caption:=»;

            lblkodIKD.Caption:=»;

            //сброс счетчиков заголовков и кадров

            CounterStaffs:=0;

            CounterHeadings:=0;

            //заголовок не читать

            Headings:=false;

          end;

        if not CheckWriteMode or not OperatingCondition then

          begin

               AssignFile(F1, ‘123.raw’);

           // IF FileExists(‘temp.raw’)

         //   then Append(F1)

        //    else Rewrite(F1);

            Caption:=’ПРОФИЛЬ 2006 — Прием записанной информации’;

            lblHelp.Caption:=’Установите герметичный переключатель режимов погружного устройства в положение «Ч».’;

            pnlReadInformation.BringToFront;

            //Очистка всех окон на панели pnlReadInformation

            lblFactoryNumber.Caption:=»;

            //сброс счетчиков заголовков и кадров

            CounterStaffs:=0;

            CounterHeadings:=0;

            CounterEndInformation:=0;

            //Иницализация пакета

            dpktOLD.Enabled:=false;

            dpktOLD.StartString:=#0+’ж’;

            dpktOLD.Enabled:=true;

            //флаг поиска заголовков по биту состояния

            Headings:=true;

            //заполнение шапки таблицы

            with StrgrdReadInformation do

              begin

                StrgrdReadInformation.RowCount:=2;

                StrgrdReadInformation.Rows[1].Clear;

                ColWidths[0]:=50;

                Cells[0,0]:=’№ п/п’;

                ColWidths[1]:=210;

                Cells[1,0]:=’Апп. номер зондирования’;

                ColWidths[2]:=120;

                Cells[2,0]:=’Число кадров’;

                ColWidths[3]:=120;

                Cells[3,0]:=’Код давления’;

              end;

          end;

      end;

   3: begin

        if not OperatingCondition or not CheckWriteMode then

          begin

            dpktOLD.Enabled:=false;

            Caption:=’ПРОФИЛЬ 2006 — Данные начала зондирования’;

            lblHelp.Caption:=’Установите герметичный переключатель режимов погружного устройства в положение «Ч».’;

            pnlEnterStartDataSounding.BringToFront;

            WITH StrgrdEnterStartDataSounding do

              begin

                SetFocus;

                ColWidths[0]:=30;

                Cells[0,0]:=’№’;

                ColWidths[1]:=75;

                Cells[1,0]:=’Дата’;

                ColWidths[2]:=75;

                Cells[2,0]:=’Время’;

                ColWidths[3]:=110;

                Cells[3,0]:=’Широта’;

                ColWidths[4]:=110;

                Cells[4,0]:=’Долгота’;

                ColWidths[5]:=75;

                Cells[5,0]:=’Глубина’;

              end

          end;

        btnForward.Caption:=’Далее >’

       end;

   4: btnForward.Caption:=’Конец’;

   5:btnExitClick(Sender);

   end;

end;

procedure TfrmProfile.btnSetingClick(Sender: TObject);

begin

// dpktOLD.Enabled:=false;

// dpktOLD.StartString:=#0+’ж’;

// dpktOLD.Enabled:=true;

 ApdComPort1.PutString(#0+’ж0’+#0#0+’я’+#0);

 ApdComPort1.PutString(#0+’ж’+#0+’№|©°’+#0+’ж’+#0+’№|©°’+#0+’ж’+#0+’№|©°’+#0+’ж’+#0+’№|©°’+#0+’ж’+#0+’№|©°’);

 ApdComPort1.PutString(#0+’ж’+#0+’№|©°’+#0+’ж’+#0+’№|©°’+#0+’ж’+#0+’№|©°’+#0+’ж’+#0+’№|©°’+#0+’ж’+#0+’№|©°’);

 ApdComPort1.PutString(#0+’ж’+#0+’№|©’#184);

 ApdComPort1.PutString(#0+’ж0’+#0#0+’я’+#0);

 ApdComPort1.PutString(#0+’ж’+#0+’№|©°’+#0+’ж’+#0+’№|©°’+#0+’ж’+#0+’№|©°’+#0+’ж’+#0+’№|©°’+#0+’ж’+#0+’№|©°’);

 ApdComPort1.PutString(#0+’ж’+#0+’№|©°’+#0+’ж’+#0+’№|©°’+#0+’ж’+#0+’№|©°’+#0+’ж’+#0+’№|©°’+#0+’ж’+#0+’№|©°’);

 ApdComPort1.PutString(#0+’ж’+#0+’№|©’#184);

 ApdComPort1.PutString(#0+’ж0’+#0#0+’я’+#0);

 ApdComPort1.PutString(#0+’ж’+#0+’№|©°’+#0+’ж’+#0+’№|©°’+#0+’ж’+#0+’№|©°’+#0+’ж’+#0+’№|©°’+#0+’ж’+#0+’№|©°’);

 ApdComPort1.PutString(#0+’ж’+#0+’№|©°’+#0+’ж’+#0+’№|©°’+#0+’ж’+#0+’№|©°’+#0+’ж’+#0+’№|©°’+#0+’ж’+#0+’№|©°’);

 ApdComPort1.PutString(#0+’ж’+#0+’№|©°’+#0+’ж’+#0+’№|©°’+#0+’ж’+#0+’№|©°’+#0+’ж’+#0+’№|©°’+#0+’ж’+#0+’№|©°’);

 ApdComPort1.PutString(#0+’ж’+#35#134+’|©’#172);

 ApdComPort1.PutString(#0+’ж’+#35#134+’|©’#172);

 //label10.Caption:=inttostr(($AC and $4));

end;

procedure TfrmProfile.dpktOLDPacket(Sender: TObject; Data: Pointer;

  Size: Integer);

var Buffer: array[0..4] of byte;

begin

  Move(Data^, Buffer[0], Size);

 if (caption=’ПРОФИЛЬ 2006 — Прием записанной информации’) and Headings=true //Buffer[4]=0 //Если 7 байт нулевой то это заголовок кадра

 then

  //прием заголовка блока записи

    begin

      Headings:=false;

      lblFactoryNumber.Caption:=inttostr(Buffer[1] shl 8+Buffer[0]);

      //увеличиваем счетчик принятых заголовков(файлов)

      inc(CounterHeadings);

      //Заполнение таблицы

      if CounterHeadings>1

      then

        begin

          StrgrdReadInformation.RowCount:=StrgrdReadInformation.RowCount+1;

          StrgrdEnterStartDataSounding.RowCount:=StrgrdReadInformation.RowCount;

//          StrgrdEnterEndDataSounding.RowCount:=StrgrdReadInformation.RowCount;

        end;

      //запись в таблицу «прием информации» порядкового номера заголовка блока

      StrgrdReadInformation.Cells[0,CounterHeadings]:=inttostr(CounterHeadings);

      //запись в таблицу «данные начала зондиования» порядкового номера (заголовка блока)

      StrgrdEnterStartDataSounding.Cells[0,CounterHeadings]:=inttostr(CounterHeadings);

      //запись в таблицу «прием информации» номера зондирования из зонда

      StrgrdReadInformation.Cells[1,CounterHeadings]:=inttostr(Buffer[3] shl 8+Buffer[2]);

      //обнуляем счетчик кадров

      CounterStaffs:=0;

    end

  else

    begin//прием кадров информации

      inc(CounterStaffs);//Увеличение счетчика кадров

      if caption=’ПРОФИЛЬ 2006 — Прием текущих кодов’ then

        begin

          lblCount.Caption:=inttostr(CounterStaffs);

          lblkodIKD.Caption:=inttostr((Buffer[0] shl 8 or ((Buffer[1] shr 4) shl 4))shr 4);

          lblkodIKT.Caption:=inttostr(Buffer[1] and $f shl 8 or Buffer[2]);

          lblkodIKP.Caption:=inttostr((Buffer[3] shl 8 or ((Buffer[4] shr 4) shl 4))shr 4);

        end

      else

        begin

          StrgrdReadInformation.Cells[2,CounterHeadings]:=inttostr(CounterStaffs);

          StrgrdReadInformation.Cells[3,CounterHeadings]:=inttostr((Buffer[0] shl 8 or ((Buffer[1] shr 4) shl 4))shr 4);

        end;

      //при приеме бита  (m=1), признака конца записи активируем расшифровку след 7 байт как заголовок

      if (Buffer[4] and $8=8) and  not (Buffer[4] and $4=4)

      then Headings:=true;

      //при преме m=1 and f=1 выводим сообщение о конце приема всей информации

      if Buffer[4] and $C=12

      then inc(CounterEndInformation);

      if CounterEndInformation=2 then

        begin

          lblHelp.Caption:=’ПРИЕМ ИНФОРМАЦИИ ЗАКОНЧЕН’;

          dpktOLD.Enabled:=false;

          Abort;

        end;

    end;

  //выкл/вкл пакета

  dpktOLD.Enabled:=false;

  dpktOLD.Enabled:=true;

end;

procedure TfrmProfile.rbtnCheckWriteClick(Sender: TObject);

begin

  //Если работа то true

  CheckWriteMode:=rbtnCheckWrite.Checked;

end;

procedure TfrmProfile.StrgrdEnterStartDataSoundingGetEditMask(Sender: TObject; ACol,

  ARow: Integer; var Value: String);

begin

    if StrgrdEnterStartDataSounding.Cells[ACol, 0] = ‘Дата’ then

    Value := ‘!99/99/0000;1’;

    if StrgrdEnterStartDataSounding.Cells[ACol, 0] = ‘Время’ then

    Value := ‘!90:00;1’;

    if StrgrdEnterStartDataSounding.Cells[ACol, 0] = ‘Широта’ then

    Value := ‘!#99:99»00″;1’;

    if StrgrdEnterStartDataSounding.Cells[ACol, 0] = ‘Долгота’ then

    Value := ‘!#99:99»00″;1’;

    if StrgrdEnterStartDataSounding.Cells[ACol, 0] = ‘Глубина’ then

    Value := ‘!9999;1’;

end;

procedure TfrmProfile.FormClose(Sender: TObject; var Action: TCloseAction);

begin

  prtOld.Open:=false;

  ApdComPort1.Open:=prtOld.Open;

  Action:=cafree;

end;

procedure TfrmProfile.StrgrdEnterStartDataSoundingSetEditText(

  Sender: TObject; ACol, ARow: Integer; const Value: String);

begin

  {

  if StrgrdEnterStartDataSounding.Cells[ACol, 0] = ‘Дата’ then

  try

    strtodate(Value)

  except

    ShowMessage(‘некорректная дата’);

    StrgrdEnterStartDataSounding.Cells[ACol, ARow]:=datetostr(now);

  end;

  }

end;

end.

Delphi