Top.Mail.Ru
Мастера DELPHI, Delphi programming community Титульная страница Поиск, карта сайта Написать письмо 
| Новости | Поиск | FAQ | Статьи | Книги | Новости VCL |
| Форумы ЧАТ | Орешник | KOL и MCK |
Форумы -» Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

« предыдущая ветвь | форум | следующая ветвь »

Зацените прогу


koha ©   (2006-08-08 21:36:00) 

Прикольный Shell для UPX сделал
http://www.elsetrue.narod.ru/UpxShell.htm

- там есть еще и другие бесплатные софтина
http://www.elsetrue.narod.ru/ModemInit.htm

Джо   (2006-08-09 02:38:00) [1]

А спамить зачем было?

Exit   (2006-08-08 22:57:00) [2]

koha если будет время, обязательно!

koha   (2006-08-08 22:50:00) [3]

> Exit

гостевухи пока нет - сайт строится!
Если шо можешь на "мыло" сбросить? "Мыло" в проге есть.

Exit   (2006-08-08 22:36:00) [4]

koha Щедро конечно, но удобнее мне кажется если на сайте разместить, Да к стати только что опробывал прогу UPX Shell EXEPacker, сжимает достаточьно хорошо, но сказать что работоспособность сжатой проги сохранилось не могу, пока не проверял досканально. Если  у тебя есть на сайте гостевуха, как нибудь оставлю там результаты теста!

koha   (2006-08-08 22:29:00) [5]

Вот юнит на прогу Modem Init, впринципе мне не жалко.
http://www.elsetrue.narod.ru/ModemInit.htm

unit Unit1;

interface

uses
 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
 Dialogs, StdCtrls, Buttons, ExtCtrls,Registry, XPMan, ImgList,Unit2;
type
 TFm = class(TForm)
   GrBox: TGroupBox;
   Edt: TEdit;
   BitBtn1: TBitBtn;
   ListBox: TListBox;
   ImgList: TImageList;
   Shape1: TShape;
   ImgHelp: TImage;
   LblHelp: TLabel;
   LblImg: TLabel;
   Tmr: TTimer;
   LblInf: TLabel;
   procedure LblHelpClick(Sender: TObject);
   procedure TmrTimer(Sender: TObject);
   procedure MouseLeave(Sender: TObject);
   procedure MouseMove(Sender: TObject; Shift: TShiftState; X,
     Y: Integer);
   procedure ImgClick(Sender: TObject);
   procedure ListBoxClick(Sender: TObject);
   procedure BitBtn1Click(Sender: TObject);
   procedure FormCreate(Sender: TObject);
   procedure EdtChange(Sender: TObject);
 private
   { Private declarations }
 public
 end;
var
 XPStyle : TXPmanifest;
 Fm      : TFm;
 Reg     : Tregistry;
 Enum    : TStrings;
 ShHi    : boolean;
 Icn     : TIcon;

 ModemClass,DefaultDevise: String;
implementation
{$R *.dfm}
{------------------------- Forma --------------------------}
procedure TFm.FormCreate(Sender: TObject);
var
 enun: string;
begin
 Edt.ReadOnly := true;
 Icn          := TIcon.Create;
 Fm.Height    := 111;
 ShHi         := false;
 Tmr.Interval := 30;
 Fm.Position  := poScreenCenter;
 fm.caption   :='Modem Init: Выберите модем';
 GrBox.Caption:=' Строка инициализации модема ';
 BitBtn1.Enabled:=false;
 ListBox.Hide;
 Edt.Clear;

 if GetEnvironmentVariable('OS') = '' then
   ModemClass:='\System\CurrentControlSet\Services\Class\Modem'
 else ModemClass:='\SYSTEM\CurrentControlSet\Control\Class\{4D36E96D-E325-11CE-BFC1-08002BE10318}';
 Enum:=TStringList.Create;
 DefaultDevise:='';

 try
 Reg:=Tregistry.Create;
 Reg.RootKey:=HKEY_CURRENT_USER;
 if Reg.OpenKey('\Software\ModemInit\Options',true) then
   if Reg.ValueExists('DefaultDevise') then begin
     DefaultDevise:=Reg.ReadString('DefaultDevise');
     Reg.CloseKey;

     Reg.RootKey:=HKEY_LOCAL_MACHINE;
     if Reg.OpenKey(ModemClass + '\' + DefaultDevise,false) then begin
       Edt.Enabled:=true;
       Edt.ReadOnly:=false;
       if Reg.ValueExists('FriendlyName') then Fm.caption:=Reg.ReadString('FriendlyName');
       if Reg.ValueExists('UserInit') then edt.Text:=Reg.ReadString('UserInit');
       Reg.CloseKey;
     end;
   end;
 Finally Reg.Free; end;
 ImgList.GetIcon(0,Icn);
 if DefaultDevise = '' then begin
   Fm.ImgClick(sender);
   ImgList.GetIcon(1,Icn);
 end;

end;
{------------------------ Function Find Modems --------------------------------}
Function Find_Devises(): string;
var i: integer;
begin
 Fm.ListBox.Clear;
 try
   Reg:=Tregistry.Create;
   Reg.RootKey:=HKEY_LOCAL_MACHINE;

   if Reg.OpenKey(ModemClass,false) then Reg.GetKeyNames(Enum);
   Reg.CloseKey;

   if Enum.Count <> 0 then begin
     For i:=0 to enum.Count -1 do begin
       if Reg.OpenKey(ModemClass + '\' + enum[i],false) then begin
         if Reg.ValueExists('FriendlyName') then
         Fm.ListBox.Items.Add(Reg.ReadString('FriendlyName')+
                           '   ('+Reg.ReadString('AttachedTo')+')');
       end;
     end;
   end else Fm.Caption:='Modem Init: Не найдено ни одного модема';
 Finally Reg.CloseKey; Reg.Free; end;
end;
{------------------------- Edit1 Modified -------------------------}
procedure TFm.EdtChange(Sender: TObject);
begin
 if edt.Modified then BitBtn1.Enabled:=true;
end;
{------------------------------------ OK --------------------------------------}
procedure TFm.BitBtn1Click(Sender: TObject);
begin
 Reg:=Tregistry.Create;
 Reg.RootKey:=HKEY_LOCAL_MACHINE;
 try
   If Reg.OpenKey(ModemClass + '\' + DefaultDevise,false) then
     Reg.WriteString('UserInit',edt.text);
 Finally Reg.CloseKey; Reg.Free; end;
 Bitbtn1.Enabled:=false;
end;
{---------------------------------- Select Modem ------------------------------}
procedure TFm.ListBoxClick(Sender: TObject);
begin
 if ListBox.ItemIndex >= 0 then
   begin
     Fm.Caption:=ListBox.Items[ListBox.ItemIndex];
     DefaultDevise:=Enum[ListBox.ItemIndex];
     Edt.Text:='';
     Edt.ReadOnly:=false;
     Try
       Reg:=TRegistry.Create;
       Reg.RootKey:=HKEY_CURRENT_USER;
       If Reg.OpenKey('\Software\ModemInit\Options',true) then begin
         Reg.WriteString('DefaultDevise',DefaultDevise);
         Reg.CloseKey;
       end;
       Reg.RootKey:=HKEY_LOCAL_MACHINE;
       If Reg.OpenKey(ModemClass + '\' + DefaultDevise,false) then begin
         If Reg.ValueExists('UserInit') then Edt.Text:=Reg.ReadString('UserInit');
         Reg.CloseKey;
       end;
     Finally Reg.Free end;
   end;
end;
{--------------------------- Show / Hide Img Click ----------------------------}
procedure TFm.ImgClick(Sender: TObject);
begin
 if ShHi = false then begin
   ShHi:=true;
   ImgList.GetIcon(1,Icn);
   Find_Devises();
   Fm.Height:=250;
   ListBox.Show;
   LblInf.Show;
 end
 else  begin
   ShHi:=false;
   ImgList.GetIcon(0,Icn);
   Fm.Height:=113;
   ListBox.Hide;
   LblInf.Hide;
 end;
end;

procedure TFm.MouseMove(Sender: TObject; Shift: TShiftState; X,
 Y: Integer);
begin
 (sender as TLabel).Cursor:=crHandPoint;
 if (sender as TLabel).Name = 'LblHelp' then begin
    (sender as TLabel).Font.Color:=$F0CAA6;
    end;
end;

procedure TFm.MouseLeave(Sender: TObject);
begin
 (sender as TLabel).Cursor:=crDefault;
 if (sender as TLabel).Name = 'LblHelp' then begin
    (sender as TLabel).Font.Color:=$FF0000;
    end;
end;
{--------------------------- Timer for refresh --------------------------------}
procedure TFm.TmrTimer(Sender: TObject);
begin
  LblImg.Canvas.Draw(1,1,Icn);
end;
{--------------------------------- Click Help ---------------------------------}
procedure TFm.LblHelpClick(Sender: TObject);
begin
 FmHelp.Position:=poMainFormCenter;
 FmHelp.ShowModal;
end;

end.

Ketmar   (2006-08-08 22:24:00) [6]

> [2] koha ©   (08.08.06 22:10)

сильно подозреваю, что виндовые...

koha   (2006-08-08 22:19:00) [7]


> Exit
</I
> Хорошо б, ешо исходники опубликовать!

>

А на что именно?

Exit   (2006-08-08 22:17:00) [8]

Хорошо б, ешо исходники опубликовать!

koha   (2006-08-08 22:10:00) [9]

Вопрос есть по поводу второй проги:
http://www.elsetrue.narod.ru/ModemInit.htm

Программа не определяет активное устройство (модем), а также устройства установленные по умолчанию (текущие). Это является недостатком программы.

Каки функции надо использовать?

KilkennyCat   (2006-08-08 21:51:00) [10]

А вопрос-то в чем?

Наверх

Титульная страница Поиск, карта сайта Написать письмо