» Вопросы по Delphi (до версии 2009) - часть 6

У меня 7-й дельф.
Выдает
[Error]: Incompatible types

Добавлено:
У меня 7-й дельф.
Выдает
[Error]: Incompatible types

Sergey_Demchuk
И на какую строку указывает? Покажите свой код.

Вот на эту строку и указывает как раз
...
if ((Buf[ii]=#$00) and (Buf[ii+1]=#$00) and (Buf[ii+2]=#$FA)) then
...

Добавлено:
Я когда определял переменную вот так
Buf: array[0..255] of Char;
ошибки нет.
Сейчас она определена Buf: array[0..255] of Byte;
Получаю
[Error] Aktualnost.dpr(208): Incompatible types

Sergey_Demchuk
Уберите символы "#", они служат для обозначения букв (Char), а вы теперь работаете с числами (Byte).

Добрый день.
Есть маленькая проблема, получаю данные от некоторого веб-сервиса в компании. Сервис написан в PHP и отдается строка "сжатая" с помощью serialize. Есть в дельфе аналог unserialize или может быть у кого-то уже есть написанный аналог unserialize?

Cryogen2003
через
1. TStringList - разделитель
2. "регулярка"
или кусочек ответа в студию
ps: Sharp Serialization Library

greenpc
да, сейчас как раз перевожу это вариант с си шарпа

Переписал этот вариант с си шарпа, вроде работает )))))
Если надо, то пользуйтесь

[more=uDeSerialize.pas]
Unit
uDeSerialize;

Interface

Type
TDeSerialize = Class(TObject)
Private
FXML: String;
FDSS: String;
StrPos: Integer;

Procedure SetXML(Const Value: String);
Procedure SetDSS(Const Value: String);
Procedure DoDeSerialize(IsArr: Boolean = False);
procedure WriteBeginXML;
procedure WriteEndXML;
Public
Constructor Create;
Destructor Destroy; Override;

Procedure DeSerialize;
Published
Property XML: String Read FXML Write SetXML;
Property DeSerializeStr: String Read FDSS Write SetDSS;
End;

Implementation

Uses
CEBUtils,
DevExpressCEB,
SysUtils,
StringUtils;

{ TDeSerialize }

Const
strNull = 'NULL';
strBool = 'BOOLEAN';
strInt = 'INTEGER';
strDouble = 'DOUBLE';
strString = 'STRING';
strArrayBegin = '<ARRAY>';
strArrayEnd = '</ARRAY>';
strUnknown = 'UNKNOWN';

Constructor TDeSerialize.Create;
Begin
StrPos := 1;
End;

Procedure TDeSerialize.WriteBeginXML;
Begin
FXML := '<?xml version="1.0" encoding="windows-1251"?>' +
'<!-- Generated by TDeSerialize --><!-- Created by Cryogen -->' +
'<DATA Version="1.0">';
End;

Procedure TDeSerialize.WriteEndXML;
Begin
FXML := FXML + '</DATA>';
End;

Procedure TDeSerialize.DeSerialize;
Begin
If IsClearText(FDSS) Then
Exit;
XML := EmptyStr;
StrPos := 1;
WriteBeginXML;
DoDeSerialize;
WriteEndXML;
End;

Destructor TDeSerialize.Destroy;
Begin

Inherited;
End;

Procedure TDeSerialize.DoDeSerialize(IsArr: Boolean = False);
Var
StrStart: Integer;
StrEnd: Integer;
chBool: Char;
stInt: String;
stDouble: String;
stLen: String;
ByteLen: Integer;
stLength: Integer;
stRet: String;
I: Integer;
Z: Integer;
Key: String;
Def: Integer;
TLen: Integer;
Begin
Case FDSS[StrPos] Of
'N':
Begin
Inc(StrPos, 2);
If Not IsArr Then
FXML := FXML + '<' + strNull + '></' + strNull + '<'
Else
FXML := FXML + strNull;
End;
'b':
Begin
chBool := FDSS[StrPos + 2];
Inc(StrPos, 4);
If Not IsArr Then
If chBool = '1' Then
FXML := FXML + '<' + strBool + '>TRUE</' + strBool + '<'
Else
FXML := FXML + '<' + strBool + '>FALSE</' + strBool + '<'
Else
If chBool = '1' Then
FXML := FXML + 'TRUE'
Else
FXML := FXML + 'FALSE';
End;
'i':
Begin
StrStart := QuickPosText(':', FDSS, StrPos) + 1;
StrEnd := QuickPosText(';', FDSS, StrStart);
stInt := Copy(FDSS, StrStart, StrEnd - StrStart);
Inc(StrPos, 3 + Length(stInt));
If Not IsArr Then
FXML := FXML + '<' + strInt + '>' + IntToStr(MyStrToInt(stInt)) +
'</' + strInt + '<'
Else
FXML := FXML + IntToStr(MyStrToInt(stInt));
End;
'd':
Begin
StrStart := QuickPosText(':', FDSS, StrPos) + 1;
StrEnd := QuickPosText(';', FDSS, StrStart);
stDouble := Copy(FDSS, StrStart, StrEnd - StrStart);
Inc(StrPos, 3 + Length(stDouble));
If Not IsArr Then
FXML := FXML + '<' + strDouble + '>' +
FloatToStr(MyStrToFloat(stDouble)) + '</' + strDouble + '<'
Else
FXML := FXML + FloatToStr(MyStrToFloat(stDouble));
End;
's':
Begin
StrStart := QuickPosText(':', FDSS, StrPos) + 1;
StrEnd := QuickPosText(':', FDSS, StrStart);
stLen := Copy(FDSS, StrStart, StrEnd - StrStart);
ByteLen := MyStrToInt(stLen);
stLength := ByteLen;
If StrEnd + 2 + stLength >= Length(FDSS) Then
stLength := Length(FDSS) - 2 - StrEnd;
stRet := Copy(FDSS, StrEnd + 2, stLength);
If QuickPosText('"', stRet) > 0 Then
Begin
stRet := Copy(stRet, 1, QuickPosText('"', stRet) - 1);
stLength := Length(stRet);
End;
Inc(StrPos, 6 + Length(stLen) + stLength);
stRet := QuickReplaceText(QuickReplaceText(QuickClearText(stRet),
#10, ''), #13, '');
If Not IsArr Then
FXML := FXML + '<' + strString + '>' + stRet + '</' + strString + '<'
Else
FXML := FXML + stRet;
End;
'a':
Begin
StrStart := QuickPosText(':', FDSS, StrPos) + 1;
StrEnd := QuickPosText(':', FDSS, StrStart);
stLen := Copy(FDSS, StrStart, StrEnd - StrStart);
stLength := MyStrToInt(stLen);
FXML := FXML + strArrayBegin;
Inc(StrPos, 4 + Length(stLen));
For I := 0 To Pred(stLength) Do
Begin
//key
FXML := FXML + '<';
DoDeSerialize(True);
Key := EmptyStr;
For Z := Length(FXML) DownTo 1 Do
If FXML[Z] <> '<' Then
Key := FXML[Z] + Key
Else
Break;
If IsClearText(Key) Then
Begin
Key := 'INDX';
FXML := FXML + Key;
End
Else
Begin
Def := StrToIntDef(Key, -779977);
If Def <> -779977 Then
Begin
TLen := Length(FXML) - Length(Key);
SetLength(FXML, TLen);
Key := 'INDX' + Key;
FXML := FXML + Key;
End;
End;
FXML := FXML + '>';
//value
DoDeSerialize(True);
FXML := FXML + '</' + Key + '>';
End;
Inc(StrPos);
If (StrPos < Length(FDSS)) And (FDSS[StrPos] = ';') Then
Inc(StrPos);
FXML := FXML + strArrayEnd;
End;
Else
Begin
If Not IsArr Then
FXML := FXML + '<' + strUnknown + '></' + strUnknown + '<'
Else
FXML := FXML + strUnknown;
End;
End;
End;

Procedure TDeSerialize.SetDSS(Const Value: String);
Begin
FDSS := Value;
End;

Procedure TDeSerialize.SetXML(Const Value: String);
Begin
FXML := Value;
End;

End.

[/more]

Кто нибудь делал сабж , типа :
Спросить у гугла как пишется правильно слово
типа ввожу : Осперин а мне не МЕГА страница а ТЕКСТ

=======
Аспирин
=======

JohnSilver182
А если попробовать что-нибудь типа Addict или ExpressSpellChecker из пакета девок. Не подойдет?

Cryogen2003
Очень интересно , правда я думаю с мега словарями YANDEX не сравнить ...

Ну да, с их словарями не сравнить, но думаю на первое время подойдет. У меня в моих проектах (где используются девки), практически везде добавляется проверка орфографии. По крайней мере перестали появляться в базе 10 ошибок в одном коротеньком предложении.

Подскажите как в этом [more]
unit sGroupBox;

interface

uses
Windows, Messages, SysUtils, Consts, Classes, Graphics, Menus, Controls, Forms;

type
TsGroupBox = class(TWinControl)
private
protected
procedure CreateParams(var Params: TCreateParams); override;
public
constructor Create(AOwner: TComponent); override;
published
property Align;
property Caption;
property Color;
property Enabled;
property Font;
property ParentColor;
property ParentFont;
property ShowHint;
property TabOrder;
property TabStop;
property Visible;
property OnClick;
property OnDblClick;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
end;

implementation

constructor TsGroupBox.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
ControlStyle := [csAcceptsControls, csClickEvents, csDoubleClicks, csReplicatable];
Width := 185;
Height := 105;
end;

procedure TsGroupBox.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
CreateSubClass(Params, 'BUTTON');
Params.Style := Params.Style or BS_GROUPBOX;
end;

end.
[/more] компоненте заставить работать свойство Hint/ShowHint ?

Frodo_Torbins


Код: Buf: array[0..255] of Byte;
...
FillMemory(@Buf, SizeOf(Buf), 0);
reg:=TRegistry.Create;
reg.RootKey:=HKEY_LOCAL_MACHINE;
reg.OpenKey('SYSTEM\CurrentControlSet\Data', false);
REG.ReadBinaryData('Data', Buf, SizeOf(Buf));
ii:=1;
if ((Buf[ii]=$00) and (Buf[ii+1]=$d3)) then
begin
TmpDate := EncodeDate(2000 + Buf[ii+5], Buf[ii+4], Buf[ii+3]);

TmpDate := IncDay(TmpDate, 50);

Buf[ii+3] := YearOf(TmpDate) - 2000;
Buf[ii+2] := MonthOf(TmpDate);
Buf[ii+4] := DayOf(TmpDate);
end;

Sergey_Demchuk
ошибок нет. D7

Код: procedure TForm1.btn5Click(Sender: TObject);
var
TmpDate: TDateTime;
ii: Integer;
Buf: array[0..255] of Byte;
begin
FillMemory(@Buf, SizeOf(Buf), 0);
ii:=1;
Buf[ii+5] :=5;
Buf[ii+4] :=3;
Buf[ii+3] :=1;
begin
TmpDate := EncodeDate(2000 + Buf[ii+5], Buf[ii+4], Buf[ii+3]);

TmpDate := IncDay(TmpDate, 50);
ShowMessage(DateToStr(TmpDate));
Buf[ii+3] := YearOf(TmpDate) - 2000;
Buf[ii+2] := MonthOf(TmpDate);
Buf[ii+4] := DayOf(TmpDate);
end;
end;

Sergey_Demchuk
Посмотрите справку по этой функции. Там параметры идут в обратном порядке: сначала год, потом месяц и день. Если вы в параметр день передадите число больше 31 (или 30, 29, 28 - в зависимости от месяца и года) то конечно получите ошибку.
И еще хорошо подумайте сколько добавлять к году, это полностью зависит от того, как он у вас записывается в реестр.

Немного перемудрил я что то. Вытягивать дату из реестра мне и не надо. А надо ее туда наоборот занести значение от текущей даты плюс 50 дней.


Код: Buf: array[0..255] of Byte;
...

Temp:=DateToStr(Date);

    AktDay:= Copy (Temp, 1, Pos('.',Temp)-1);
    Temp:= StringReplace (Temp, AktDay + '.','',[rfIgnoreCase]);
    AktMonth:= Copy (Temp, 1, Pos('.',Temp)-1);
    Temp:= StringReplace (Temp, AktMonth + '.','',[rfIgnoreCase]);
    AktYear:= Temp;
FillMemory(@Buf, SizeOf(Buf), 0);
reg:=TRegistry.Create;
reg.RootKey:=HKEY_LOCAL_MACHINE;
reg.OpenKey('SYSTEM\CurrentControlSet\Data', false);
REG.ReadBinaryData('Data', Buf, SizeOf(Buf));
ii:=1;
if ((Buf[ii]=$00) and (Buf[ii+1]=$d3)) then
begin
TmpDate := EncodeDate(StrToInt(AktYear), StrToInt(AktMonth), StrToInt(AktDay));

TmpDate := IncDay(TmpDate, 50);

Buf[ii+3] := YearOf(TmpDate) - 2000;
Buf[ii+2] := MonthOf(TmpDate);
Buf[ii+4] := DayOf(TmpDate);


end;

Sergey_Demchuk
Текущая дата плюс 50 дней: "TmpDate := IncDay(Date, 50);".
Хотелось бы посмотреть конечное значение в реестре и дату, которую оно представляет. А то мне кажется, что вы путаете местами день и год. Вы вообще знаете как в переводе с английского будет "year, day"?

У меня возникла проблема с функцией ShellExecute.
Некоторое время назад сделал простенькую программку для тестирования. Эта программа при запуске (по процедуре FormCreate) загружает несколько bmp-файлов из директории interface (находится прямо рядом с Project1.exe, в одной папке то есть) следующим образом:

Код:
Bitmap1 := TBitmap.Create;
Bitmap1.LoadFromFile('.\interface\logo.bmp');

Frodo_Torbins
Нет, не путаю.
Было в реестре .. AD 0A 97 .. что означает 23/04/2009 (день-месяц-год, такая посл. в реестре)
Далее открываю ексель-файл, который выщитывает по формуле, которую я описывал выше.
Он выдает значения, которые я должен занести в реестр, т.е. дату 05/04/11 (50 дней считая от сегодня). Это должны быть значения ....FF FE 95...
Теперь пробуем программой. Результат: в реестре значения ...05 04 0B..., т.е. совсем не те, которые надо...
Я эти значения нахожу вот так.

Код: DateSeparator := '.';
Temp:=DateToStr(Date+50);

    AktDay:= Copy (Temp, 1, Pos('.',Temp)-1);
    Temp:= StringReplace (Temp, AktDay + '.','',[rfIgnoreCase]);
    AktMonth:= Copy (Temp, 1, Pos('.',Temp)-1);
    Temp:= StringReplace (Temp, AktMonth + '.','',[rfIgnoreCase]);
    AktYear:= Temp;

IntDay:=IntToBin(StrToInt(AktDay),8);
IntMonth:=IntToBin(StrToInt(AktMonth),8);
IntYear:=IntToBin(StrToInt(AktYear)-1900,8);
Maska:=IntToBin(250,8);
for ii:=1 to 8 do begin
OneDay:= Copy (IntDay,ii,1);
TwoDay:= Copy (Maska,ii,1);
OneMonth:= Copy (IntMonth,ii,1);
TwoMonth:= Copy (Maska,ii,1);
OneYear:= Copy (IntYear,ii,1);
TwoYear:= Copy (Maska,ii,1);
if OneDay = TwoDay
Then
begin
ThreeDay:='0';
FroeDay:= FroeDay + ThreeDay;
end
else
begin
ThreeDay:='1';
FroeDay:= FroeDay + ThreeDay;
end;

if OneMonth = TwoMonth
Then
begin
ThreeMonth:='0';
FroeMonth:= FroeMonth + ThreeMonth;
end
else
begin
ThreeMonth:='1';
FroeMonth:= FroeMonth + ThreeMonth;
end;

if OneYear = TwoYear
Then
begin
ThreeYear:='0';
FroeYear:= FroeYear + ThreeYear;
end
else
begin
ThreeYear:='1';
FroeYear:= FroeYear + ThreeYear;
end;

end;

HexDataDay:= BinToHex (FroeDay);
HexDataMonth:= BinToHex (FroeMonth);
HexDataYear:= BinToHex (FroeYear);

RuPurple


Делай загурзку где то так:

Bitmap1.LoadFromFile(ExtractFilePath(Application.ExeName)+'\interface\logo.bmp');

RuPurple
Вы используете относительные пути к файлам, которые высчитываются в зависимости от активной директории. В ShellExecute вы не указываете активную директорию, поэтому берется текущая для этой "другой программки". Самый оптимальный способ решения этой проблемы - указывать полные пути к файлам. К примеру: "Bitmap1.LoadFromFile(ExtractFilePath(ParamStr(0))+'\interface\logo.bmp');".

Sergey_Demchuk
AD 0A 97 по вашему алгоритму не соответствует 23/04/2009. С FF FE 95 и 05/04/11 все в порядке.

Цитата:

Я думал что прокатит Buf[ii+5] := (YearOf(TmpDate)-2000) xor 250 но результат тоже неверен.

В вашем случае надо 1900 отнимать. Тогда этот вариант выдаст 95 (или 149 в десятичной системе) для 2011 года. Для месяца и дня тоже самое но без отнимания:
Код: Buf[ii+4] := MonthOf(TmpDate) xor 250;
Buf[ii+3] := DayOf(TmpDate) xor 250;

Frodo_Torbins, tanaseduard, спасибо вам!
Но мне бы не хотелось переделывать первую программу для тестирования. Может быть есть какой-нибудь способ заставить ShellExecute работать нормально? Или использовать что-нибудь вместо него?
Кстати, пробовал еще WinExec, но результат тот же самый.

RuPurple

Тогда посмотри в сторону изменения директории, перед запуском приложения меняешь текущую директорию на директорию запускаемого приложения, после запуска восстанавливаешь свою.
Названия функции не припомню, возможно как параметр к Shell.

Посмотри ф. ChangeDir -вроде так называлась, хотя я не уверен что это с этого языка програмирования.

RuPurple
Заполните параметр Directory: https://sites.google.com/site/skyersoft/praktika-v-delphi/shellexecute-description

Frodo_Torbins
Попробовал два варианта:
ShellExecute(Handle,nil,PChar('C:\Shell\TEST\Project1.exe'),nil,PChar('C:\Shell\TEST\'),SW_SHOW);
и перед функцией ShellExecute вставить
SetCurrentDirectory('C:\Shell\TEST\');
Все равно та же ошибка выскакивает...

RuPurple
С помощью Process Explorer-а можно посмотреть какая же на самом деле активная директория у процесса. Запустите свой Project1.exe и гляньте.

Frodo_Torbins
Активная директория оказалась 'Рабочий стол\Shell' (самому интересно как )
Перезагрузил компьютер, по новой переписал строку кода с ShellExecute, с указанием в нем параметра директории по умолчанию, и все нормально заработало.
Огромное вам спасибо!

RuPurple
Активная директория может меняться в процессе работы программы. К примеру диалоги открытия/сохранения файла обычно ее изменяют. Даже какой нибудь хук пунто свитчера или прога добавляющая кнопки в заголовоки всех окон в системе могут вмешаться. Поэтому вам первым делом и посоветовали использовать полные пути.

Помогите пожалуйста с hint-ом, после того как hint сам исчезнет то при повторном наведении курсора он не отображается, это наблюдается в WinXP при исользовании манифеста.
[more]
uses
CommCtrl;

procedure CreateHint(Wnd: HWND; Text: PChar);
var
HintWnd: HWND;
ti: TToolInfo;
begin
InitCommonControls;
HintWnd := CreateWindowEx(0, 'tooltips_class32', nil, TTS_ALWAYSTIP, 0, 0, 0, 0, 0, 0, hInstance, nil);
ti.cbSize := SizeOf(TToolInfo);
ti.uFlags := TTF_IDISHWND or TTF_SUBCLASS;
ti.uId := Wnd;
ti.hInst := hInstance;
ti.lpszText := Text;
SendMessage(HintWnd, TTM_ADDTOOL, 0, integer(@ti));
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
CreateHint(Button1.Handle, 'API Hint');
end;
[/more]