Считывание данных из memo только в Шестнадцатеричном формате , ошибка ,если данные в memo не соответствуют hex (Pascal) Дельфи7

[sergey.serg-72]

Задача заключается в следующем : надо данные из memo считать только, в Шестнадцатеричном формате и записать.
Если данные в hex формате, то проблем записи нет, а вот ,если данные в memo имеют русские буквы, или не содержат формата ['0'..'9', 'A'..'F', 'a'..'f']), то ошибка ...

Как реализовать проверку перед записью из memo, чтоб , если данные не соответствуют Шестнадцатеричному формату, то выскакивает окно об ошибке showMessage('error'); и запись не производится.
p.s
Запрет на ввод кроме как латинице, не подходит. Так как в memo загружаются имена файлов, которые должны загружаться как в hex, так и русские буквы, а вот запись, только для имён в hex.

Мозг весь сломал, третий день сижу, но не выходит....

var
FS: TFileStream;
buf:  string;
begin
if opendialog1.Execute then
begin
Buf:=  Memo2.Lines.Text;
FS := TFileStream.Create(OpenDialog1.FileName, fmOpenReadWrite ,fmShareDenyWrite);
Label4.Caption:='Размер  : '+ IntToStr(FS.Size)+' ' + ' ' +'Байт';
Memo1.Text:=ExtractFileName(OpenDialog1.FileName+sLineBreak);
buf:=HexToStr(buf);
SetLength(buf,  length(buf));
FS.Position :=Strtoint('$' + edit1.Text) ;
FS.Write(Buf[1], length(buf));
MessageBox(handle,PChar('Данные  записаны  и  файл  сохранён !'+#13#10), PChar('Сообщение'), 64);
FS.Free;
end;
end;

пробую так, но не выходит,ошибка что на hex, что на русские буквы...

  begin
   for i := 1 to Length(buf) do
 if not (buf[i] in ['0'..'9', 'A'..'F', 'a'..'f']) then
begin
 Application.MessageBox('error', 'message', MB_Ok + MB_ICONINFORMATION);
 FS.Free;
exit;
end;

[sergey.serg-72]

Сообщение от sergey.serg-72

Мозг весь сломал, третий день сижу, но не выходит....

Ура !!! получилось, решил задачу !

 var
FS: TFileStream;
buf:  string;
begin
if opendialog1.Execute then
begin
Buf:=  Memo2.Lines.Text;
FS := TFileStream.Create(OpenDialog1.FileName, fmOpenReadWrite ,fmShareDenyWrite);
Label4.Caption:='Размер  : '+ IntToStr(FS.Size)+' ' + ' ' +'Байт';
Memo1.Text:=ExtractFileName(OpenDialog1.FileName+sLineBreak);
 if not (buf[1] in ['0'..'9', 'A'..'F', 'a'..'f']) then
begin
 Application.MessageBox('error', 'message', MB_Ok + MB_ICONINFORMATION);
 FS.Free;
exit;
end;
buf:=HexToStr(buf);
SetLength(buf,  length(buf));
FS.Position :=Strtoint('$' + edit1.Text) ;
FS.Write(Buf[1], length(buf));
MessageBox(handle,PChar('Данные  записаны  и  файл  сохранён !'+#13#10), PChar('Сообщение'), 64);
FS.Free;
end;
end;

Нет, всё же есть баг, в коде..
Если в имени есть так :Cu, или Ar получается что пропускает и уходит в ошибку.
И почему то неправильно реагирует на i, может как единицу воспринимает ?
В общем код не совершенен, надо как то и первую и вторую буквы проверять?
Прошу помощи зала, плиз !!!

Что то поклёвки совсем нет..... Что задача не выполнима, или я тихо спрашиваю ?

[BDA]

Так а чем цикл не подошел по всем буквам? И причём тут имена файлов?

procedure TForm1.Button1Click(Sender: TObject);
var
  FS: TFileStream;
  buf: string;
  i: Integer;
begin
  if OpenDialog1.Execute then
  begin
    buf := Memo2.Lines.Text;
    if length(buf) mod 2 <> 0 then
    begin
      MessageBox(handle, PChar('Строка с данными нечетной длины'), PChar('Ошибка'), MB_ICONERROR);
      exit;
    end;
    for i := 1 to Length(buf) do
      if not (buf[i] in ['0'..'9', 'A'..'F', 'a'..'f']) then
      begin
        MessageBox(handle, PChar('В строке с данными недопустимые символы'), PChar('Ошибка'), MB_ICONERROR);
        exit;
      end;
    FS := TFileStream.Create(OpenDialog1.FileName, fmOpenReadWrite, fmShareDenyWrite);
    Label4.Caption := 'Размер: ' + IntToStr(FS.Size) + ' Байт';
    Memo1.Text := ExtractFileName(OpenDialog1.FileName);
    buf := HexToStr(buf);
    FS.Position := StrToInt('$' + Edit1.Text);
    FS.Write(buf[1], length(buf));
    MessageBox(handle, PChar('Данные записаны и файл сохранён!'), PChar('Сообщение'), MB_ICONINFORMATION);
    FS.Free;
  end;
end;

[sergey.serg-72]

Задача заключалась в следующем :
1) форма, на ней две кнопки, первой кнопкой загружаем файл, каждый файл имеет название(имя) : 1.bin, RTY. bin , название(имя) файла выводится в мемо, а далее второй кнопкой считываем имя файла и записываем в hex формате, если имя файла не содержит hex формат, при загрузке ошибка ! скажем Y,T,R не входят в hex, значит два варианта: 1) ошибка записи, 2) пробуем перевести в hex и записать.
CUR - имя файла, прога пропускает, так как первая стоит С.. А значит уже ошибка записи.
Если CUR, перевожу в hex то выходит так :43 55 52 вроде всё оккей, но при записи с моим кодом ошибка и пишет типа это не hex. А ,если в имени будет третья, или четвёртая буква не hex?
ABAS, DACY и.т.д. Код не сработает и ошибка.
Но почему с моим кодом, после перевода в hex ошибка, я не пойму ни как ? 43 55 52
Такое задание дали....

Сообщение от BDA

Так а чем цикл не подошел по всем буквам? И причём тут имена файлов?

И ваш код в ошибку уходит, имя файла в мемо CUR, прога не даёт его к загрузке, всё вроде гуд !, но вот далее перевожу это имя в hex 43 55 52 всё должно быть гуд, а фиг вам, как говорится , записывать и в таком формате не хочет, уходит в ошибку, а это неправильно...
В чём проблема не могу понять, что не нравится?

[BDA]

Сообщение от sergey.serg-72

записывать и в таком формате не хочет, уходит в ошибку

Потому что я предполагал текст с hex-кодами без пробелов. Тогда такой вариант: предполагаем формат hex-строки "xx xx xx", т.е. по две 16-ричные цифры через пробел.

uses StrUtils;

...

function IsHexStr(const s: string): Boolean;
var
  i: Integer;
begin
  Result := False;
  if Length(s) mod 3 <> 2 then
    Exit;
  for i := 1 to Length(s) do
  case i mod 3 of
    0: if s[i] <> ' ' then Exit;
    1: if not (s[i] in ['0'..'9', 'A'..'F', 'a'..'f']) then Exit;
  else if not (s[i] in ['0'..'9', 'A'..'F', 'a'..'f']) then Exit;
  end;
  Result := True;
end;

function StrToHex(const s: string): string;
const
  hexs: string = '0123456789ABCDEF';
var
  i, k: Integer;
  v: Byte;
begin
  if Length(s) = 0 then
  begin
    Result := '';
    Exit;
  end;
  SetLength(Result, 3 * Length(s) - 1);
  v := Ord(s[1]);
  Result[1] := hexs[v shr 4 + 1];
  Result[2] := hexs[v and $F + 1];
  k := 3;
  for i := 2 to Length(s) do
  begin
    v := Ord(s[i]);
    Result[k] := ' ';
    Result[k + 1] := hexs[v shr 4 + 1];
    Result[k + 2] := hexs[v and $F + 1];
    Inc(k, 3);
  end;
end;

function ExtractFileNameOnly(const FileName: string): string;
var
  I, J: Integer;
begin
  I := LastDelimiter(PathDelim + DriveDelim, FileName);
  J := PosEx('.', FileName, I + 1);
  if J <> 0 then
    Result := Copy(FileName, I + 1, J - I - 1)
  else
    Result := Copy(FileName, I + 1, MaxInt);
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  fn: string;
begin
  if OpenDialog1.Execute then
  begin
    fn := ExtractFileNameOnly(OpenDialog1.FileName);
    Memo1.Text := fn;
    if IsHexStr(fn) then
      Memo2.Text := fn
    else
      Memo2.Text := StrToHex(fn);
  end;
end;

procedure TForm1.Button2Click(Sender: TObject);
var
  FS: TFileStream;
  buf: string;
begin
  if OpenDialog1.Execute then
  begin
    buf := Memo2.Text;
    if not IsHexStr(buf) then
    begin
        MessageBox(handle, PChar('Не HEX-строка'), PChar('Ошибка'), MB_ICONERROR);
        exit;
    end;
    buf := HexToStr(buf);
    FS := TFileStream.Create(OpenDialog1.FileName, fmOpenReadWrite, fmShareDenyWrite);
    Label4.Caption := 'Размер: ' + IntToStr(FS.Size) + ' Байт';
    FS.Position := StrToInt('$' + Edit1.Text);
    FS.Write(buf[1], length(buf));
    FS.Free;
    MessageBox(handle, PChar('Данные записаны и файл сохранён!'), PChar('Сообщение'), MB_ICONINFORMATION);
  end;
end;

[sergey.serg-72]

Сообщение от BDA

Потому что я предполагал текст с hex-кодами без пробелов. Тогда такой вариант: предполагаем формат hex-строки "xx xx xx", т.е. по две 16-ричные цифры через пробел.

BDA, спасибо ! но тоже есть не до чёт, А именно : а, если имя такое : ABCDEF1234567890 это переводить не надо так как это Шестнадцатеричные значение и переводить их не надо, а так и записывать, а с вашем кодом переводит в 41 42 43 44 45 46 31 32 33 34 35 36 37 38 39 30 и так записывает, а это не гуд !

var
FS: TFileStream;
buf,fn:  string;
begin
if opendialog1.Execute the
begin
fn := ExtractFileNameOnly(OpenDialog1.FileName);
Memo1.Text := fn;
if IsHexStr(fn) then
 Memo2.Text := fn
 else
 Memo2.Text := StrToHex(fn);
 end;
buf := Memo2.Text;
if not IsHexStr(buf) then
begin
MessageBox(handle, PChar('Не HEX-строка'), PChar('Ошибка'), MB_ICONERROR);
exit;
end;
FS := TFileStream.Create(OpenDialog1.FileName, fmOpenReadWrite ,fmShareDenyWrite);
Label4.Caption:='Size : '+ IntToStr(FS.Size)+' ' + ' ' +'byte';
Memo1.Text:=ExtractFileName(OpenDialog1.FileName+sLineBreak);
buf:= HexToStr(buf);
SetLength(buf,  length(buf));
FS.Position :=Strtoint('$' + edit1.Text) ;
FS.Write(Buf[1], length(buf));
MessageBox(handle,PChar('Данные записаны и файл сохранён !'+#13#10), PChar('message'), 64);
FS.Free;
end;
end;

procedure TForm1.Button2Click(Sender: TObject);
var t:TStringList;
begin
Memo2.Lines.Text := StrToHex(Memo2.Lines.Text);
t:=TStringList.Create;
t.DelimitedText:=Memo2.Text;
end;

[BDA]

Сообщение от sergey.serg-72

но тоже есть не до чёт, А именно : а, если имя такое : ABCDEF1234567890 это переводить не надо

Тогда функция IsHexStr должна два варианта поддерживать: с пробелами и без.

function IsHexStr(const s: string): Boolean;
var
  i, len: Integer;
begin
  Result := False;
  len := Length(s);
  if (len > 2) and (s[3] = ' ') then
  begin
    if len mod 3 <> 2 then
      Exit;
    for i := 1 to len do
    case i mod 3 of
      0: if s[i] <> ' ' then Exit;
      1: if not (s[i] in ['0'..'9', 'A'..'F', 'a'..'f']) then Exit;
    else if not (s[i] in ['0'..'9', 'A'..'F', 'a'..'f']) then Exit;
    end;
  end
  else
  begin
    if len mod 2 <> 0 then
      Exit;
    for i := 1 to len do
      if not (s[i] in ['0'..'9', 'A'..'F', 'a'..'f']) then Exit;
  end;
  Result := True;
end;

[sergey.serg-72]

Сообщение от BDA

Тогда функция IsHexStr должна два варианта поддерживать: с пробелами и без.

BDA Огромное , огромное спасибо! то что доктор прописал! вот в чём загвоздка , но я знал, что должна была быть засада в чём то, слишком он лукаво улыбался, когда говорил, что задача лёгкая... Но ''прочуял Окадэмик, в чём резончик''.... Так и вышло .

BDA, а возможно вообще реализовать такую задачу :
У файла ,есть имя скажем BDA_123_SER_.bin
При загрузке файла в программу,

if opendialog1.Execute then
begin

Программа выводила окно :

 showmessage('В имени файла есть слово SER, будьте внимательны это не Hex !  ');

Просто уверен, что завтра будет такое задание...
И такое возможно реализовать ?

[BDA]

Сообщение от sergey.serg-72

такое возможно реализовать ?

Да, возможно.

fn := ExtractFileNameOnly(OpenDialog1.FileName);
if Pos('_SER_', fn) > 0 then
  showmessage('В имени файла есть слово SER, будьте внимательны это не Hex!');

[sergey.serg-72]

Сообщение от BDA

Да, возможно.

fn := ExtractFileNameOnly(OpenDialog1.FileName);
if Pos('_SER_', fn) > 0 then
  showmessage('В имени файла есть слово SER, будьте внимательны это не Hex!');

var
FS: TFileStream;
buf,fn:  string;
begin
if opendialog1.Execute then
begin
fn := ExtractFileNameOnly(OpenDialog1.FileName);
if Pos('_SER_', fn) > 0 then
  showmessage('Â èìåíè ôàéëà åñòü ñëîâî SER, áóäüòå âíèìàòåëüíû ýòî íå Hex!');
Memo1.Text := fn;
if IsHexStr(fn) then
 Memo2.Text := fn
 else
 Memo1.Text := StrToHex(fn);
 end;
 begin
buf := Memo1.Text;
if not IsHexStr(buf) then
begin
MessageBox(handle, PChar('Íå HEX-ñòðîêà'), PChar('Îøèáêà'), MB_ICONERROR);
exit;
end;
FS := TFileStream.Create(OpenDialog1.FileName, fmOpenReadWrite ,fmShareDenyWrite);
Label4.Caption:='Size : '+ IntToStr(FS.Size)+' ' + ' ' +'byte';
Memo1.Text:=ExtractFileName(OpenDialog1.FileName);
buf:= HexToStr(buf);
SetLength(buf,  length(buf));
FS.Position :=Strtoint('$' + edit1.Text) ;
FS.Write(Buf[1], length(buf));
MessageBox(handle,PChar('Äàííûå çàïèñàíû è ôàéë ñîõðàí¸í !'+#13#10), PChar('message'), 64);
FS.Free;
end;
end;

Создал форму код, но что то не реагирует на SER, пропускает, не возникает окошко.