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

VandB
Что значит просмотр? Гаджеты имеют вполне определенный формат, и хранятся в специальных папках на диске. Организовать список вроде бы не проблема.

data man
Писал же

Люди, помогите в маленькой проблемке. Вот чего-то навскидку не могу вспомнить как сделать кое что-то.
Есть код определенный на HTML (форма для ввода):


Код:

<form action="http://myserver:8080/FileSave" enctype="multipart/form-data" method="post" name="JBOSS" id="JBOSS">
FN: <input type="file" name="FN" id="FN" />
FILENAME: <input type="text" name="FILENAME" id="FILENAME" />
PROJECT: <input type="text" name="PROJECT" size=40 id="PROJECT" value="2007/1/25/PASSPORT" />
C_DOCID: <input type="text" name="C_DOCID" id="C_DOCID" value="30002061" />
ZIPPED: <input type="text" name="ZIPPED" id="ZIPPED" value="0" />
<input type="submit" name="TYPE" id="TYPE" value="PUT" />
</form>

Cryogen2003
Вопрос "А что случилось ?" задал не я.
Я не использую INDY так что - сам, сам, сам

data man
Да уже разобрался, оказался сам дурак
Оказывается параметр TYPE надо тоже передавать, а я думал он просто так
А так, может быть кому-то будет интересно

Код:
Procedure TForm1.cxButton2Click(Sender: TObject);
Var
Data: TIdMultiPartFormDataStream;
URL: String;
Begin
URL := 'http://myserver:8080/FileSave';
IdHTTP1.Request.Accept := 'text/plain';
IdHTTP1.Request.ContentType := 'multipart/form-data';
Data := TIdMultiPartFormDataStream.Create;
Try
//Data.RequestContentType := 'multipart/form-data';
Data.AddFile('FN', FilenameEdit1.FileName, 'text/plain');
Data.AddFormField('FILENAME', ExtractFileName(FilenameEdit1.FileName));
Data.AddFormField('PROJECT', '2007/1/25/PASSPORT');
Data.AddFormField('C_DOCID', edtId.Text);
Data.AddFormField('ZIPPED', '0');
Data.AddFormField('TYPE', 'PUT');
Memo1.Lines.Text := IdHTTP1.Post(URL, Data);
Finally
Data.Free;
End;
IdHTTP1.Disconnect;
End;

Привет всем!
Помогите как вставить кнопка в ячейке Dbgrid?
Мне надо, чтобы на каждой строке рисовать три кнопки
Удалить Сохранить Редактировать когда стою на активную запись
Есть Dbgrid c данными 4 полей + добавил еще колонку в гриде
и на форму положил три TButtona
formoncreate сделал
button.visible:=false

Код: procedure TfrmCMPMain.grdOperDrawColumnCell(Sender: TObject;
const Rect: TRect; DataCol: Integer; Column: TColumn;
State: TGridDrawState);
var
DrawState: Integer;
DrawRect: TRect;
begin
if (gdfocused in State) then
begin
if (Column.index =5) then
with button do
begin
Left := Rect.Left + grdOper.Left + 2;
Top := Rect.Top + grdOper.Top + 2;
Width := Rect.Right - Rect.Left;
Width := Rect.Right - Rect.Left;
Height := Rect.Bottom - Rect.Top;
Visible := True;
end
end;

Frodo_Torbins
Я это знаю )))))))))
Нет мне надо запускать эти гаджет приложения в своей программе, как в боковой панели windows vista, это возможно?

Добавлено:
Вот смог импортировать dll из папки боковой панели получился компанент TWLServices , и как им пользоваться, он не визуальный.?

VandB
описание можно найти в Visual Studio М$. там пробегал мануал к SDK.

VandB
"Запускать эти гаджеты" означает написать второй сайдбар. Если кому то из присутствующих это и под силу, то займет ооочень много времени.

Frodo_Torbins
Понял. А можно сделать активным "открыть в новой вклаке" ? В меню веббраузера?

Добавлено:
В Visual Studio 2008 предусмотрено и создание этих гаджетов и запуск в своих программах, на сайте мелкософт щас прочитал.

Добрый день. Необходимо создать ярлык впн подключения на рабочем столе. Нашел код на просторах интернет, сделал под свои нужды. Вобщем-то так толком не трогал ничего, так как плохо разбираюсь в делах взаимодействия с системной оболочкой и ее интерфейсами. Собственно, код впринципе работоспособен, только под Windows 2000 приложение вылетает с ошибкой, но ярлык при этом также создается. Не знаю что там происходит, но понаставив мессаджбоксов посмотрел что вероятно что-то связанное с освобождением указателя pMalloc и вызов CoUninitialize в поцедуре CreateShellVpnLink. Даже кажется что из-за вызова CoUninitialize все это происходит. Кому не сложно гляньте что не так там.

[more=Читать дальше..]function NextID(pidl: PItemIDList): PItemIDList;
begin
Result := pidl;
Inc(PAnsiChar(Result), pidl^.mkid.cb);
end;

function PIDLSize(pidl: PItemIDList): DWORD;
begin
Result := 0;
if Assigned(pidl) then
begin
Result := SizeOf(Word);
while (pidl.mkid.cb <> 0) do
begin
Result := Result + pidl.mkid.cb;
pidl := NextID(pidl);
end;
end;
end;

function IsDesktopFolder(pidl: PItemIDList): Boolean;
begin
if Assigned(pidl) then
Result := (pidl.mkid.cb = 0)
else
Result := FALSE;
end;

function ConcatPIDL(destpidl, srcpidl: PItemIDList): PItemIDList;
var
DestPIDLSize: Integer;
SrcPIDLSize : Integer;
ppMalloc : IMalloc;
begin
Result := nil;
if (SHGetMalloc(ppMalloc) = S_OK) then
try
DestPIDLSize := 0;
SrcPIDLSize := 0;
if Assigned(destpidl) then
begin
if not IsDesktopFolder(destpidl) then
DestPIDLSize := PIDLSize(destpidl) - SizeOf(destpidl^.mkid.cb);
end;
if Assigned(srcpidl) then
SrcPIDLSize := PIDLSize(srcpidl);
Result := ppMalloc.Alloc(DestPIDLSize + SrcPIDLSize);
if Assigned(Result) then
begin
if Assigned(destpidl) then
CopyMemory(Result, destpidl, DestPIDLSize);
if Assigned(srcpidl) then
CopyMemory(PAnsiChar(Result) + DestPIDLSize, srcpidl, SrcPIDLSize);
end;
finally
ppMalloc := nil;
end;
end;

procedure CreateShellVpnLink(szEntryName: WideString);
var
LinkInterf: IUnknown;
ShellLink : IShellLink;
PFile : IPersistFile;
szFileName: WideString;
ppidl1 : PItemIDList;
ppidl2 : PItemIDList;
ppidl3 : PItemIDList;
Desktop : IShellFolder;
Network : IShellFolder;
Items : IEnumIDList;
dwFetched : Cardinal;
Connection: STRRET;
NameObj : WideString;
pszPath : Array [0..MAX_PATH] of WideChar;
pMalloc : IMalloc;
begin
CoInitialize(nil);

if (SHGetMalloc(pMalloc) = S_OK) then
try

SHGetSpecialFolderLocation(0, CSIDL_CONNECTIONS, ppidl1);
try

if (SHGetDesktopFolder(Desktop) = S_OK) then
begin
Desktop.BindToObject(ppidl1, nil, IID_IShellFolder, Network);
Network.EnumObjects(0, SHCONTF_NONFOLDERS, Items);
while (Items.Next(1, ppidl2, dwFetched) = S_OK) do
begin
if (dwFetched > 0) and Assigned(ppidl2) then
try
Network.GetDisplayNameOf(ppidl2, SHGDN_NORMAL, Connection);
case Connection.uType of
//STRRET_CSTR: SetString(NameObj, Connection.cStr, lstrlen(Connection.cStr));
STRRET_WSTR: NameObj := Connection.pOleStr;
end;
if (NameObj = szEntryName) then
begin
CoCreateInstance(CLSID_ShellLink, nil, CLSCTX_INPROC_SERVER or CLSCTX_LOCAL_SERVER, IUnknown, LinkInterf);
ShellLink := LinkInterf as IShellLink;
PFile := LinkInterf as IPersistFile;
with ShellLink do
begin
ppidl3 := ConcatPIDL(ppidl1, ppidl2);
try
SetIDList(ppidl3);
finally
pMalloc.Free(ppidl3);
end;
end;
ZeroMemory(@pszPath, SizeOf(pszPath));
SHGetSpecialFolderLocation(0, CSIDL_DESKTOP, ppidl3);
try
SHGetPathFromIDListW(ppidl3, @pszPath);
szFileName := FormatW('%s\%s.lnk', [ExcludeTrailingPathDelimiterW(pszPath), szEntryName]);
PFile.Save(@szFileName[1], FALSE);
finally
pMalloc.Free(ppidl3);
end;
end;
finally
pMalloc.Free(ppidl2);
end;
end;
end;

finally
pMalloc.Free(ppidl1);
end;

finally
pMalloc := nil;
end;

CoUninitialize;
end;[/more]

Использую Indy для сервера, к которому цепляются приборы, кол-во которых доходит до 500 штук, постоянно конектятся 100-150. Ну и соответственно большое кол-во потоков создается. Только вот я заметил, что это кол-во все растет и растет... а когда переваливает за 2000 выскакивает исключение и прога виснет. Это что так, со всеми компонентами Indy? Может быть мне их заменить?

Indy компоненты просто обертки над сокетами Win API, так что всегда можешь обратится к ним, вместо использования компонентов, что эффективней и сложней в программировании.
Поэтому я бы порекомендовал обратится к штукам вроде IdThreadMgrPool и версии Делфи/Indy. Смысл в том, что Indy подерживает два типа архитектуры (хотя бы теоритически): когда каждому клиенту создаётся поток и когда изначально создаётся какое-то число потоков (ограниченое), которое в дальнейшем и используется.

GPSGURU
Проблема Indy в том, что стремясь объять всё, они сделали библиотеку чересчур тяжелой.
Рекомендую посмотреть на RealThinClient , благо он стал бесплатным.
Ну и ICS, конечно.

P.S. Возможно некоторые ошибки в Indy исправлены. Ежедневные сборки здесь.

Во, сделал, правда все равно не уверен что интерфейсные указатели освобождаются до конца. Кому интересно как создать ярлык сетевого подключения на рабочем столе. Проверял на Windows 2000, Windows XP, Windows 7. Проверьте кто разбирается в COM интерфейсах.

[more=">>>"]function GetNextItemID(pidl: PItemIDList): PItemIDList;
var
cb: DWORD;
begin
Result := nil;
if (pidl = nil) then
Exit;
cb := pidl.mkid.cb;
if (cb = 0) then
Exit;
pidl := PItemIDList(Cardinal(pidl) + cb);
if (pidl.mkid.cb <> 0) then
Result := pidl;
end;

//

function GetPIDSize(pidl: PItemIDList): DWORD;
begin
Result := 0;
if (pidl <> nil) then
begin
Result := SizeOf(pidl.mkid.cb);
while (pidl <> nil) do
begin
Inc(Result, pidl.mkid.cb);
pidl := GetNextItemID(pidl);
end;
end;
end;

//

function IsDesktopFolder(pidl: PItemIDList): Boolean;
begin
if Assigned(pidl) then
Result := (pidl.mkid.cb = 0)
else
Result := FALSE;
end;

//

function ConcatPIDL(destpidl, srcpidl: PItemIDList): PItemIDList;
var
cb1: DWORD;
cb2: DWORD;
pmc: IMalloc;
hr : HRESULT;
begin
Result := nil;
hr := SHGetMalloc(pmc);
if SUCCEEDED(hr) then
begin
cb1 := 0;
cb2 := 0;
if Assigned(destpidl) then
begin
if not IsDesktopFolder(destpidl) then
cb1 := GetPIDSize(destpidl) - SizeOf(destpidl^.mkid.cb);
end;
if Assigned(srcpidl) then
cb2 := GetPIDSize(srcpidl);
Result := pmc.Alloc(cb1 + cb2);
if Assigned(Result) then
begin
if Assigned(destpidl) then
CopyMemory(Result, destpidl, cb1);
if Assigned(srcpidl) then
CopyMemory(Pointer(DWORD(Result) + cb1), srcpidl, cb2);
end;
pmc := nil;
end;
end;

//

procedure CreateShellVpnLink(szEntryName: WideString);
var
pMalloc : IMalloc;
Desktop : IShellFolder;
pidlDesktop: PItemIDList;
pszPath : Array [0..MAX_PATH] of WideChar;
pidlConnect: PItemIDList;
Network : IShellFolder;
Items : IEnumIDList;
pidl2 : PItemIDList;
dwFetched : Cardinal;
Connection : STRRET;
ObjectName : WideString;
pfLink : IUnknown;
isLink : IShellLink;
ipFile : IPersistFile;
pidl3 : PItemIDList;
szFileName : WideString;
begin

// acquire shell's allocator
if (SHGetMalloc(pMalloc) = S_OK) then
try

// acquire shell namespace root folder
if (SHGetDesktopFolder(Desktop) = S_OK) then
try

if (SHGetSpecialFolderLocation(0, CSIDL_DESKTOP, pidlDesktop) = S_OK) then
try
ZeroMemory(@pszPath, SizeOf(pszPath));
SHGetPathFromIDListW(pidlDesktop, @pszPath);

if (SHGetSpecialFolderLocation(0, CSIDL_CONNECTIONS, pidlConnect) = S_OK) then
try
Desktop.BindToObject(pidlConnect, nil, IID_IShellFolder, Network);
Network.EnumObjects(0, SHCONTF_NONFOLDERS, Items);

while (Items.Next(1, pidl2, dwFetched) = S_OK) do
try

if (dwFetched > 0) and Assigned(pidl2) then
try
Network.GetDisplayNameOf(pidl2, SHGDN_NORMAL, Connection);
ObjectName := Connection.pOleStr;

if (ObjectName = szEntryName) then
try
CoCreateInstance(CLSID_ShellLink, nil, CLSCTX_INPROC_SERVER, IUnknown, pfLink);
isLink := pfLink as IShellLink;
ipFile := pfLink as IPersistFile;

pidl3 := ConcatPIDL(pidlConnect, pidl2);
isLink.SetIDList(pidl3);
szFileName := FormatW('%s\%s.lnk', [ExcludeTrailingPathDelimiterW(pszPath), szEntryName]);
ipFile.Save(@szFileName[1], FALSE);
pMalloc.Free(pidl3);

finally
// для Delphi необязательно вызывать Release у интерфейса, так
// как для них предусмотрена compiler magic и компилятор все
// сделает сам, иначе мы получим ошибку - метод Release будет
// вызван несколько раз
//pfLink := nil;
//isLink := nil;
//ipFile := nil;
end;

finally
pMalloc.Free(pidl2); // release folder
end;

finally
end;

finally
Network := nil;
pMalloc.Free(pidlConnect); // release folder
end;

finally
pMalloc.Free(pidlDesktop); // release folder
end;

finally
Desktop := nil; // release shell namespace root folder
end;

finally
pMalloc := nil; // release shell's allocator
end;

end;[/more]

Подскажите пожалуйста по ZipTV
есть ли более менее детальное описание этой компоненты??
а именно интересует TZipCheck для того чтобы проверить кучу файлов
и TUnARJ, чтобы распаковать.
Буду признателен.

Как в TOpenDialog/TSaveDialog в событии OnTypeChange сделать смену расширение у файла?
Присвоение OpenDialog1.FileName ни к чему не приводит.

zolivan
я бы посоветовал юзать zip forge пятой версии..она укомплектована и докамии примерами...ниже версию лучше не брать ибо с багами..

Andrey128
[more=Код для отладки]
Код:
// фильтр задан как '*.*|*.*|txt|*.txt|doc|*.doc'
var
I: Integer;
OD: TOpenDialog;
begin
OD := (Sender as TOpenDialog);
I := OD.FilterIndex;
if I = 1 then
OD.FileName := '1.1';
if I = 2 then
OD.FileName := '1.txt';
if I = 3 then
OD.FileName := '1.doc';
memo1.Lines.Append(OD.FileName);
end;

data man
Не совсем понял вас. Код для отладки - это событие OnTypeChange?
Даже если так, то все равно в самом диалоге расширение не меняется.

Может я не совсем корректно задал вопрос?
Попробую еще раз: как сделать чтобы в открытом диалоге TOpenDialog/TSaveDialog при смене типа файла, автоматом менялось расширение в строке ввода файла.
Например в Delphi:
1. Открываем любой юнит
2. Делаем сохранить как
3. Руками меняем расшинение на .txt (Unit1.txt)
4. Меняем тип на Any file (*.*)
5. Меняем расширение на Delphi unit (*.pas)
раширение меняется на .pas

Нашел такой код, в принципе то-что нужно, но хотелось бы стандартными средствами обойтись.

Andrey128
Тогда не понимаю в чем проблема.
Я задал DefaultExt = 'pas', фильтр = 'pas|*.pas|any|*.*'
И у меня диалог сохранения работает именно так, как Вам нужно.
P.S. По крайней мере на Delphi 2009 именно так.
P.P.S. Так работает только диалог сохранения.

mdid
Пятой версией - это такие как ZipForge 2.55 ZipForge 2.67?

zolivan
http://www.componentace.com/download/download.php?editionid=12

data man
Вы правы, если задать DefaultExt, то работает как надо.
Спасибо.

Может кто подскажет модуль типа ZipForge, который сможет работать с ARJ архивами?

zolivan
Уже было
Но тестирования архивов там нет, извлечение есть.

zolivan

SevenzipVcl
Code:
http://www.rg-software.de/

Rar Component
Code:
http://www.philippewechsler.ch/rar_component.php

ZipMaster
Code:
http://www.delphizip.org/

Standalone compress / decompress:
Code:
http://www.birtles.org.uk/programming/

А как можно сделать так, чтобы чтобы при вставки в текст (например смайлика "") мигаюший курсор стоял после вставленного знака а не в начале текста, ( вставка может быть в любой части текста), Вот это не подходит:
Memo1.text:= Memo1.text + 'Мой текст';.
А мне надо так:
Memo1.text:= Memo1.text + 'Мой текст'(СЮДА КУРСОР);
или например :
Memo1.text:= Memo1.text + '<H1>'( СЮДА КУРСОР) '</H1>; Как мне это сделать???

VandB
так идет небольшой хак через selstart selend попробуй ими поиграться или в инете посмотри, я помню так делал.

ShIvADeSt дело говорит, просто увеличьте их на длину вставляемой строки

Привет всем.
Создал приложение в котором есть главная форма Form1 и дочерняя Form2.
На Form1 размещен cxPageControl, Form2 вызывается след образом и помещается в PageControl. Подскажите как узнать хендл формы на выбранной странице PageControla.
var
myForm: TForm;
begin
myForm:= FindForm(FormClassType);
if myForm = nil then begin
Application.CreateForm(FormClassType, 'Form2');
TForm('Form2').ManualDock(PageControl);
PageControl.ActivePageIndex := PageControl.PageCount-1;
TForm('Form2').Show;
end;
end;