Текущий архив: 2006.08.27;
Скачать: CL | DM;

Вниз

Зацените прогу   Найти похожие ветки 

← →
koha ©   (2006-08-08 21:36) [0]

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

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

---

← →
KilkennyCat ©   (2006-08-08 21:51) [1]

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

---

← →
koha ©   (2006-08-08 22:10) [2]

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

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

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

---

← →
Exit   (2006-08-08 22:17) [3]

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

---

← →
koha ©   (2006-08-08 22:19) [4]

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

>

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

---

← →
Ketmar ©   (2006-08-08 22:24) [5]

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

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

---

← →
koha ©   (2006-08-08 22:29) [6]

Вот юнит на прогу 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.

---

← →
Exit   (2006-08-08 22:36) [7]

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

---

← →
koha ©   (2006-08-08 22:50) [8]

> Exit

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

---

← →
Exit   (2006-08-08 22:57) [9]

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

---

← →
Джо ©   (2006-08-09 02:38) [10]

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

---

Страницы: 1 вся ветка

Текущий архив: 2006.08.27;
Скачать: CL | DM;

Наверх

Память: 0.48 MB
Время: 0.028 c