25. Jak odczytać numer seryjny i etykiete dyskietki, dysku
Dla dysku metoda ta podaje tylko numer seryjny partycji. Dla dyskietki wszystko jest OK
var
Bufor : array[0..MAX_PATH] of Char;
MaxCompLength,FileSystemFlags:Integer;
Drive : Char;
Serial : DWORD;
begin
Drive:='A';
GetVolumeInformation(PChar(Drive +
':'),Bufor,SizeOf(Bufor),@Serial,MaxCompLength,FileSystemFlags,nil,0);
end;
Zmienna Serial posiada numer seryjny dyskietki, a bufor nazwę etykiety.[/b]
if (Etykieta = '') and (DriveType = DRIVE_CDROM) then Etykieta:= 'Stacja dysków CD';
if (Etykieta = '') and (DriveType = DRIVE_FIXED) then Etykieta:='Dysk lokalny';
if (DriveType = DRIVE_CDROM) then rodzaj := 'Napęd CD-ROM: ';
if (DriveType = DRIVE_FIXED) then rodzaj := 'Dysk Twardy: ';
if (DriveType = DRIVE_UNKNOWN) then rodzaj := 'Nieznany typ dysku: ';
unit MainFrm;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls;
type
TMainForm = class(TForm)
btnGetIPName: TButton;
procedure btnGetIPNameClick(Sender: TObject);
end;
var
MainForm: TMainForm;
implementation
{$R *.DFM}
uses WinSock; // <-- wazny modul umozliwiajacy pobieranie adresu IP
procedure GetIPAndName(var IPAddress : PChar; var ACompName : PCHar);
var
Host : PHostEnt;
CompName : array[0..MAX_PATH] of char; // Nazwa zalogowanego uzytkownika
IP : PChar; // adres IP komputera
begin
//Pobieramy nazwę komputera i przypisujemy ja zmiennej "CompName"
GetHostName(@CompName, MAX_PATH);
Host := GetHostByName(@CompName); // uzyskanie nazway uzytkownika
//przypisanie zmiennej "ACompName" nazwy uzytkownika
ACompName := Host^.h_name;
//Pobieramy jego adres IP ( urzyte tu zostalo rzutowanie )
IP := iNet_ntoa(PInAddr(Host^.h_addr_list^)^);
IPAddress := IP; // przypisanie zmiennej "IPAddress" nazwy IP
end;
procedure TMainForm.btnGetIPNameClick(Sender: TObject);
var
IP : PChar;
CName : PCHar;
TF : TextFile; // plik tekstowy
begin
{
Wykonaj procedure i przypisz jej parametry dwom zmiennym: IP oraz CName
}
GetIPandName(IP, CName);
AssignFile(TF, 'C:IP.txt'); // skojarz zmienna z nazwa tworzonego pliku
try
Rewrite(TF); // zapisz plik na dysku
Writeln(TF, 'Adres IP: ' + IP); // zapisz do pliku linie
Writeln(TF, 'Nazwa użytkownika: ' + CName);
finally
CloseFile(TF); // zakoncz zapisywanie do pliku
end;
end;
var
VER : WORD;
Data : TWSAData;
initialization
begin
//Ładujemy bibliotekę Winsock
VER := MAKEWORD(1, 0);
WSAStartup(VER, Data);
end;
finalization
WSACleanup; // zwolnij biblioteke Winsock
end.
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
>>>>>>>>>>>>>>>Tutaj<<<<<<<<<<<<<<<<
end.
unit TiMain;
interface
uses
Windows, Messages, SysUtils, Classes, Controls, Forms, Dialogs,
StdCtrls, ExtCtrls, Menus, ImgList, CoolTrayIcon, ComCtrls;
type
TMainForm = class(TForm)
Button1: TButton;
Button2: TButton;
Button3: TButton;
PopupMenu1: TPopupMenu;
ShowWindow1: TMenuItem;
HideWindow1: TMenuItem;
N1: TMenuItem;
Exit1: TMenuItem;
ImageList1: TImageList;
rdoCycle: TRadioGroup;
GroupBox1: TGroupBox;
Label1: TLabel;
Label2: TLabel;
GroupBox2: TGroupBox;
Label3: TLabel;
Edit1: TEdit;
CheckBox1: TCheckBox;
CheckBox2: TCheckBox;
CheckBox3: TCheckBox;
CheckBox4: TCheckBox;
CheckBox5: TCheckBox;
CheckBox6: TCheckBox;
Edit2: TEdit;
Label4: TLabel;
ImageList2: TImageList;
ImageList3: TImageList;
ImageList4: TImageList;
ImageList5: TImageList;
procedure FormCreate(Sender: TObject);
procedure ShowWindow1Click(Sender: TObject);
procedure HideWindow1Click(Sender: TObject);
procedure Exit1Click(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Edit1Change(Sender: TObject);
procedure CheckBox1Click(Sender: TObject);
procedure CheckBox2Click(Sender: TObject);
procedure TrayIcon1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure TrayIcon1MouseMove(Sender: TObject; Shift: TShiftState;
X, Y: Integer);
procedure CheckBox3Click(Sender: TObject);
procedure CheckBox4Click(Sender: TObject);
procedure CheckBox5Click(Sender: TObject);
procedure rdoCycleClick(Sender: TObject);
procedure TrayIcon1Cycle(Sender: TObject; NextIndex: Integer);
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
end;
var
MainForm: TMainForm;
implementation
{$R *.DFM}
procedure TMainForm.FormCreate(Sender: TObject);
begin
Edit1Change(Self);
CheckBox1Click(Self);
CheckBox2Click(Self);
CheckBox3Click(Self);
CheckBox4Click(Self);
CheckBox5Click(Self);
rdoCycleClick(Self);
TrayIcon1.Refresh;
end;
procedure TMainForm.ShowWindow1Click(Sender: TObject);
begin
TrayIcon1.ShowMainForm;
end;
procedure TMainForm.HideWindow1Click(Sender: TObject);
begin
TrayIcon1.HideMainForm;
end;
procedure TMainForm.Exit1Click(Sender: TObject);
begin
Close;
// MessageDlg('Yo!', mtInformation, [mbOk], 0);
end;
procedure TMainForm.Button1Click(Sender: TObject);
begin
TrayIcon1.HideMainForm;
end;
procedure TMainForm.Button2Click(Sender: TObject);
begin
TrayIcon1.IconVisible := not TrayIcon1.IconVisible;
end;
procedure TMainForm.Edit1Change(Sender: TObject);
begin
TrayIcon1.Hint := Edit1.Text;
end;
procedure TMainForm.CheckBox1Click(Sender: TObject);
begin
TrayIcon1.ShowHint := CheckBox1.Checked;
end;
procedure TMainForm.CheckBox2Click(Sender: TObject);
begin
if Assigned(PopupMenu1) then
PopupMenu1.AutoPopup := CheckBox2.Checked;
end;
procedure TMainForm.CheckBox3Click(Sender: TObject);
begin
TrayIcon1.LeftPopup := CheckBox3.Checked;
end;
procedure TMainForm.CheckBox4Click(Sender: TObject);
begin
TrayIcon1.Enabled := CheckBox4.Checked;
end;
procedure TMainForm.CheckBox5Click(Sender: TObject);
begin
TrayIcon1.MinimizeToTray := CheckBox5.Checked;
end;
procedure TMainForm.TrayIcon1MouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
if Assigned(PopupMenu1) then
if not PopupMenu1.AutoPopup then
MessageDlg('The popup menu is disabled.', mtInformation, [mbOk], 0);
end;
procedure TMainForm.TrayIcon1MouseMove(Sender: TObject; Shift: TShiftState;
X, Y: Integer);
begin
{ X and Y coords. are returned in screen coords. I don't know if
it is possible to convert them to the tray icon's client coords.,
but it's hardly relevant in any case. }
Label1.Caption := 'Mouse pos.: ' + IntToStr(X) + ',' + IntToStr(Y);
Label2.Caption := 'Key status: ';
if ssCtrl in Shift then
Label2.Caption := Label2.Caption + ' Ctrl ';
if ssAlt in Shift then
Label2.Caption := Label2.Caption + ' Alt ';
if ssShift in Shift then
Label2.Caption := Label2.Caption + ' Shift ';
end;
procedure TMainForm.rdoCycleClick(Sender: TObject);
begin
If rdoCycle.ItemIndex = 0 then
begin
TrayIcon1.CycleIcons := False;
TrayIcon1.IconList := nil;
ImageList1.GetIcon(0, TrayIcon1.Icon);
TrayIcon1.Refresh; // Remember to refresh
Edit2.Text := IntToStr(TrayIcon1.IconIndex);
end
else
begin
case rdoCycle.ItemIndex of
1: TrayIcon1.IconList := ImageList1;
2: TrayIcon1.IconList := ImageList2;
3: TrayIcon1.IconList := ImageList3;
4: TrayIcon1.IconList := ImageList4;
5: TrayIcon1.IconList := ImageList5;
end;
TrayIcon1.CycleIcons := True;
end;
end;
procedure TMainForm.TrayIcon1Cycle(Sender: TObject; NextIndex: Integer);
begin
Edit2.Text := IntToStr(TrayIcon1.IconIndex);
end;
procedure TMainForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
CanClose := (not CheckBox6.Checked);
if not CanClose then
begin
TrayIcon1.HideMainForm;
TrayIcon1.IconVisible := True;
end;
end;
end.
[Error] TiMain.pas(76): Undeclared identifier: 'TrayIcon1'
[Error] TiMain.pas(82): Undeclared identifier: 'TrayIcon1'
[Error] TiMain.pas(88): Undeclared identifier: 'TrayIcon1'
[Error] TiMain.pas(101): Undeclared identifier: 'TrayIcon1'
[Error] TiMain.pas(107): Undeclared identifier: 'TrayIcon1'
[Error] TiMain.pas(107): Missing operator or semicolon
[Error] TiMain.pas(113): Undeclared identifier: 'TrayIcon1'
[Error] TiMain.pas(119): Undeclared identifier: 'TrayIcon1'
[Error] TiMain.pas(132): Undeclared identifier: 'TrayIcon1'
[Error] TiMain.pas(138): Undeclared identifier: 'TrayIcon1'
[Error] TiMain.pas(144): Undeclared identifier: 'TrayIcon1'
[Error] TiMain.pas(178): Undeclared identifier: 'TrayIcon1'
[Error] TiMain.pas(179): Missing operator or semicolon
[Error] TiMain.pas(180): There is no overloaded version of 'GetIcon' that can be called with these arguments
[Error] TiMain.pas(184): ';' expected but 'ELSE' found
[Error] TiMain.pas(186): Undeclared identifier: 'rdoCycle'
[Error] TiMain.pas(186): ',' or ':' expected but 'OF' found
[Error] TiMain.pas(187): Undeclared identifier: 'TrayIcon1'
[Error] TiMain.pas(187): Undeclared identifier: 'ImageList1'
[Error] TiMain.pas(188): Missing operator or semicolon
[Error] TiMain.pas(188): Undeclared identifier: 'ImageList2'
[Error] TiMain.pas(189): Missing operator or semicolon
[Error] TiMain.pas(189): Undeclared identifier: 'ImageList3'
[Error] TiMain.pas(190): Missing operator or semicolon
[Error] TiMain.pas(190): Undeclared identifier: 'ImageList4'
[Error] TiMain.pas(191): Missing operator or semicolon
[Error] TiMain.pas(191): Undeclared identifier: 'ImageList5'
[Error] TiMain.pas(193): Missing operator or semicolon
[Error] TiMain.pas(194): '.' expected but ';' found
[Warning] TiMain.pas(195): Text after final 'END.' - ignored by compiler
[Error] TiMain.pas(56): Unsatisfied forward or external declaration: 'TMainForm.TrayIcon1Cycle'
[Error] TiMain.pas(57): Unsatisfied forward or external declaration: 'TMainForm.FormCloseQuery'
[Fatal Error] dclusr.dpk(39): Could not compile used unit '..CoolTrayTiMain.pas'
ależ nie, on taki musi byc...wybierasz zly komponent.[/b]
--->Server
"....Tworzymy nowa aplikacje. Wstawiamy komponent serversocket, ustawiamy w nim port taki jaki wpisalismy do klienta teraz zeby server byl aktywny zaraz po wlaczeniu kompa active:true. Przechodzimy do zakladki Events klikami dwa razy na OnClientRead (tu beda zmienne cdopen i cdclose)...."[/b]