Programlama yapalım ve Öğrenelim.

Xml Rss Okuyucu & Media Oynatıcı

{Merhaba Arkadaşlar..

Yazdığım son programımın tüm kodlarını burada ayınlamak istedim.

Yaklaşık 2003 ten beri bu işlerle uğraşıyorum ama şöyle oturup ağız tadıyla

işe yarar bir program yazmak için pekte vaktim olmamıştı.Okuldu askerlikti şuydu buydu derken ...

Herneyse..

Şimdi diyeceksinizki Xml Rss Okuma ve de mediaplayer ne alaka .ama bunu yaparken ilk düşüncem

son dakika haberlerini alabilmekti...

daha sonra dedimki haberleri okurken bir yandanda müzik dinlesem nasıl olur dedim ..

ve en sonunda böyle bir şey ortaya çıktı...

Tabii bu arada sizlerinde katkısı çok büyük takıldığım noktalarda Kodbank hep elimin altındaydı

Kodlar ve sıralaması bazı yerlerde karışık gelebilir.Ancak bunu çözebileceğinize eminim.

Bu arada müzik dinlerken dinlediğiniz Müzik MSN den görünüyor..

Bu da küçük bir artısı ...

Herneyse...

Artık kodları vereyim ....

}

//--------------------------Unit1.pas-------------------------

unit Unit1;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs,ExtActns, StdCtrls, ComCtrls, Buttons, xmldom, XMLIntf, msxmldom,

XMLDoc, ExtCtrls, LMDCustomSimpleLabel, LMDSimpleLabel, LMDBaseControl,

LMDBaseGraphicControl, LMDBaseLabel, LMDInformationLabel, LMDControl,

LMDCustomControl, LMDCustomPanel, LMDCustomBevelPanel,

LMDCustomStatusBar, LMDStatusBar, Spin, JvComponentBase, JvDesktopAlert,

JvBaseDlg, ImgList, JvImageList, jpeg, JvGIF, SXPNGUtils, JvExControls,

JvaScrollText, JvScrollText, JvFormMagnet, JvTrayIcon,WinInet,

JvgTransparentMemo, JvgDigits, JvLED, JvSpecialProgress, Menus,

LMDCustomComponent, LMDWndProcComponent, LMDTrayIcon, MPlayer,

JvFormAnimation, JvFormTransparent, Mask, DBCtrls, JvDBControls;

type

TForm1 = class(TForm)

lblUrl: TLabel;

XMLDoc: TXMLDocument;

Timer1: TTimer;

alarm: TJvDesktopAlert;

JvDesktopAlertStack1: TJvDesktopAlertStack;

ImageList1: TImageList;

Image1: TImage;

lv: TListView;

GroupBox3: TGroupBox;

Label1: TLabel;

CheckBox1: TCheckBox;

SpinEdit1: TSpinEdit;

BitBtn1: TBitBtn;

Image2: TImage;

lblBaslik: TLabel;

Image3: TImage;

Image4: TImage;

JvFormMagnet1: TJvFormMagnet;

scrol2: TJvScrollText;

SpinEdit2: TSpinEdit;

Label2: TLabel;

Timer2: TTimer;

scrol: TJvScrollText;

led: TJvLED;

Image5: TImage;

JvSpecialProgress1: TJvSpecialProgress;

LMDTrayIcon1: TLMDTrayIcon;

PopupMenu1: TPopupMenu;

GSTER1: TMenuItem;

N1: TMenuItem;

IKI1: TMenuItem;

JvFormAnimation1: TJvFormAnimation;

Image6: TImage;

PopupMenu2: TPopupMenu;

IKI2: TMenuItem;

JvLED1: TJvLED;

Bun: TButton;

Button1: TButton;

JvDBNavigator1: TJvDBNavigator;

Memo1: TMemo;

DBEdit1: TDBEdit;

DBComboBox1: TDBComboBox;

DBText1: TDBText;

Image7: TImage;

Image8: TImage;

Image9: TImage;

procedure BitBtn1Click(Sender: TObject);

procedure lvSelectItem(Sender: TObject; Item: TListItem;

Selected: Boolean);

procedure BunClick(Sender: TObject);

procedure CheckBox1Click(Sender: TObject);

procedure Timer1Timer(Sender: TObject);

procedure memoAciklamaMouseMove(Sender: TObject; Shift: TShiftState; X,

Y: Integer);

procedure SpinEdit1Change(Sender: TObject);

procedure lvMouseMove(Sender: TObject; Shift: TShiftState; X,

Y: Integer);

procedure lvDblClick(Sender: TObject);

procedure lblUrlMouseMove(Sender: TObject; Shift: TShiftState; X,

Y: Integer);

procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

procedure Image1DblClick(Sender: TObject);

procedure Panel1Click(Sender: TObject);

procedure Image4Click(Sender: TObject);

procedure SpinEdit2Change(Sender: TObject);

procedure Timer2Timer(Sender: TObject);

procedure Image5Click(Sender: TObject);

procedure FormCreate(Sender: TObject);

procedure GSTER1Click(Sender: TObject);

procedure IKI1Click(Sender: TObject);

procedure LMDTrayIcon1DblClick(Sender: TObject);

procedure Image6Click(Sender: TObject);

procedure IKI2Click(Sender: TObject);

procedure JvLED1Click(Sender: TObject);

procedure DBMemo1Change(Sender: TObject);

procedure DBComboBox1Change(Sender: TObject);

procedure Image7Click(Sender: TObject);

procedure DBEdit1Change(Sender: TObject);

procedure Image8Click(Sender: TObject);

procedure Image2DblClick(Sender: TObject);

procedure FormClose(Sender: TObject; var Action: TCloseAction);

procedure Image9Click(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form1: TForm1;

btime,btimefark:ttime;

otoplam,toplam:dword;

Buffer: array[0..1024] of Char;

BytesRead,NumWritten: dWord;

ToF: file;

implementation

uses Unit2, Unit3, Unit4, Unit5, Unit6, Unit7;

{$R *.dfm}

function DownloadURLFile(const strUrl, strLocalFile : TFileName) : boolean;

begin Result:=True; with TDownLoadURL.Create(nil) do

try URL:=strUrl; Filename:=strLocalFile;

try ExecuteTarget(nil);

except Result:=False;

end;

finally Free;

end;

function UserOnline:boolean;

var

connect_status:dword;

begin

connect_status := 2 {lan} +

1 {modem} +

4 {proxy} ;

result := InternetGetConnectedState(@connect_status,0);

end;

procedure gy_DownloadFile_to_file(const Url: string;File1,File2: String; Obj:TObject);

var

NetHandle: HINTERNET;

UrlHandle: HINTERNET;

Buffer: array[0..1024] of Char;

Toplam, BytesRead,NumWritten: dWord;

ToF: file;

begin

Toplam:=0;

NetHandle := InternetOpen('Delphi 5.x', INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0);

if Assigned(NetHandle) then

begin

UrlHandle := InternetOpenUrl(NetHandle, PChar(Url), nil, 0, INTERNET_FLAG_RELOAD, 0);

if Assigned(UrlHandle) then

{ UrlHandle valid? Proceed with download }

begin

FillChar(Buffer, SizeOf(Buffer), 0);

AssignFile(ToF, file1);

//Rewrite(ToF, 1); { Record size = 1 }

repeat

FillChar(Buffer, SizeOf(Buffer), 0);

InternetReadFile(UrlHandle, @Buffer, SizeOf(Buffer), BytesRead);

Toplam := Toplam + BytesRead;

if assigned(Obj) and ( Obj is TLabel) then

TLabel(obj).caption := File2+' '+ FloatToStr(Toplam)+' Byte indi ' ;

//BlockWrite(ToF, Buffer, BytesRead,NumWritten);

Application.ProcessMessages;

until BytesRead = 0;

InternetCloseHandle(UrlHandle);

//CloseFile(ToF);

end

else

{ UrlHandle is not valid. Raise an exception. }

raise Exception.CreateFmt('%s URL adresi açılamıyor...', [Url]);

InternetCloseHandle(NetHandle);

end

else

{ NetHandle is not valid. Raise an exception }

raise Exception.Create('Wininet kurulumu yapılamıyor...');

end;

procedure TForm1.Timer2Timer(Sender: TObject);

begin

if UserOnline = true then

led.Active:=true

//trpmem.Lines.Add('[Çevrimiçi]')

//ShowMessage('Internet bağlantı durumu: Online')

else

led.Active:=false;

//ShowMessage('Internet bağlantı durumu: Offline');

if led.Active=true then

led.Hint:='Çevrimiçi'

else

led.Hint:='Çevrimdışı';

end;

procedure TForm1.BitBtn1Click(Sender: TObject);

var

strLocalFile : TFileName;

StartItemNode : IXMLNode; ANode : IXMLNode; STitle, sDesc, sLink : widestring;

Obj1:TObject;

begin

//if form5.ADOTable1.Active=true then

memo1.Lines.Clear;

lv.Clear;

memo1.Lines.Add(dbedit1.Text);

//internetteki dosyanın bilgisayarda kaydedileceği yol

strLocalFile :=IncludeTrailingPathDelimiter(ExtractFilePath(Application.ExeName)) + 'temp.xml';

//form3.Show;

Screen.Cursor:=crHourglass;

try if not DownloadURLFile(Memo1.Lines.Text, strLocalFile) then // http://www.aa.com.tr/rss/ajansguncel.xml

begin

Screen.Cursor:=crDefault;

Raise

Exception.CreateFmt('Sayfa alınamadı. Lütfen internet bağlantınızı kontrol edin.',[]);

Exit;

end;

if not FileExists(strLocalFile) then

begin

Screen.Cursor:=crDefault;

raise exception.Create('Dosya bulunamadı');

Exit;

end;

lv.Clear;

XMLDoc.FileName := strLocalFile;

XMLDoc.Active:=True; //hangi sıradaki elemanlara ulaşmak istediğimizi ayarlıyoruz

StartItemNode := XMLDoc.DocumentElement.ChildNodes.First.ChildNodes.FindNode('item');

ANode := StartItemNode; //bütün elemanlara erişebilmek için döngüye alıyoruz

repeat STitle := ANode.ChildNodes['title'].Text;

sLink := ANode.ChildNodes['link'].Text;

sDesc := ANode.ChildNodes['description'].Text; //değerleri listviewe ekliyoruz...

with LV.Items.Add do

begin

Caption := STitle;

SubItems.Add(sLink);

SubItems.Add(sDesc);

end; //düğümü bir sonraki düğüme eşitleyip devam ediyoruz.

//pointerlarla linked list uygulaması yapanlara bu mantık çok

//tanıdık gelecektir

ANode := ANode.NextSibling;

until ANode = nil;

finally

DeleteFile(strLocalFile);

Screen.Cursor:=crDefault;

end;

procedure TForm1.lvSelectItem(Sender: TObject; Item: TListItem;

Selected: Boolean);

begin

if lv.ItemIndex = -1 then

exit;

lblBaslik.Caption :=' '+ lv.Items[lv.ItemIndex].Caption;

lblUrl.Caption := lv.Selected.SubItems[0];

//urllbl.Caption := lv.Selected.SubItems[0];

//richedit1.Text:=lv.Selected.SubItems[1];

form2.RichEdit1.Text:=lv.Selected.SubItems[1];

alarm.HeaderText:= lv.Selected.Caption;

alarm.MessageText:=lv.Selected.SubItems[1];

alarm.Execute;

scrol.Items.Clear;

scrol.Items.Add(lv.Selected.Caption);

scrol.Active:=true;

scrol2.Active:=true;

//scrol.Lines.Add(lv.Selected.Caption);

//memo2.Lines.Add(lv.Selected.Caption);

if FileExists('adres.txt') then

memo1.Lines.SaveToFile('adres.txt');

end;

procedure TForm1.BunClick(Sender: TObject);

begin

xmldoc.FileName:=memo1.Lines.Text;

if xmldoc.Active=false then

xmldoc.Active:=true

else

xmldoc.Active:=false;

//listbox1.Items.Add(xmldoc.XML.Text);

end;

procedure TForm1.CheckBox1Click(Sender: TObject);

begin

Timer1.Interval:=spinedit1.Value*1000;

IF checkbox1.Checked=true THEN

if timer1.Enabled=false then

timer1.Enabled:=true

else

timer1.Enabled:=false;

end;

procedure TForm1.Timer1Timer(Sender: TObject);

begin

bitbtn1.Click();

end;

procedure TForm1.memoAciklamaMouseMove(Sender: TObject; Shift: TShiftState;

X, Y: Integer);

begin

groupbox3.Visible:=false;

end;

procedure TForm1.SpinEdit1Change(Sender: TObject);

begin

Timer1.Interval:=Spinedit1.Value*1000;

end;

procedure TForm1.lvMouseMove(Sender: TObject; Shift: TShiftState; X,

Y: Integer);

begin

//form2.Show;

end;

procedure TForm1.lvDblClick(Sender: TObject);

begin

form1.ActiveControl:=lblbaslik.FocusControl;

form2.Show;

end;

procedure TForm1.lblUrlMouseMove(Sender: TObject; Shift: TShiftState; X,

Y: Integer);

begin

groupbox3.Visible:=true;

end;

procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

begin

ReleaseCapture;

Form1.perform(WM_SYSCOMMAND, $F012, 0);

end;

procedure TForm1.Image1DblClick(Sender: TObject);

begin

Close;

end;

procedure TForm1.Panel1Click(Sender: TObject);

begin

if groupbox3.Visible=false then

groupbox3.Visible:=true

else

groupbox3.Visible:=false;

end;

procedure TForm1.Image4Click(Sender: TObject);

begin

Form1.Hide;

if form2.Showing=true then

form2.Hide;

end;

procedure TForm1.SpinEdit2Change(Sender: TObject);

begin

lv.Font.Size:=spinedit2.Value;

end;

procedure TForm1.Image5Click(Sender: TObject);

begin

form3.Show;

bitbtn1.Click();

end;

procedure TForm1.FormCreate(Sender: TObject);

begin

//form5.ADOTable1.Active:=

//bitbtn1.Click();//Image2.OnClick(Self);

end;

procedure TForm1.GSTER1Click(Sender: TObject);

begin

form1.Show;

end;

procedure TForm1.IKI1Click(Sender: TObject);

begin

Form1.Close;

end;

procedure TForm1.LMDTrayIcon1DblClick(Sender: TObject);

begin

if form1.Showing=false then

Form1.Show

else

form1.Hide;

end;

procedure TForm1.Image6Click(Sender: TObject);

begin

form4.show;

end;

procedure TForm1.IKI2Click(Sender: TObject);

begin

Form1.Close;

end;

procedure TForm1.JvLED1Click(Sender: TObject);

begin

form5.ADOTable1.ConnectionString:='Provider=Microsoft.Jet.OLEDB.4.0;Data Source=.serversServers.mdb;Persist Security Info=False';

form5.ADOTable1.TableName:='sunucu';

if jvled1.Active=false then

form5.ADOTable1.active:=false

else

form5.ADOTable1.active:=true;

if jvled1.Active=false then

jvled1.Active:=true

else

jvled1.Active:=false;

//bitbtn1.OnClick(self);

end;

procedure TForm1.DBMemo1Change(Sender: TObject);

begin

memo1.Lines.Add(dbedit1.Text);

end;

procedure TForm1.DBComboBox1Change(Sender: TObject);

begin

bitbtn1.Click;

end;

procedure TForm1.Image7Click(Sender: TObject);

begin

Form7.Show;

end;

procedure TForm1.DBEdit1Change(Sender: TObject);

begin

bitbtn1.Click;

end;

procedure TForm1.Image8Click(Sender: TObject);

begin

form3.Show;

bitbtn1.Click();

end;

procedure TForm1.Image2DblClick(Sender: TObject);

begin

if groupbox3.Visible=false then

groupbox3.Visible:=true

else

groupbox3.Visible:=false;

end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);

begin

//if MessageDlg('Programdan çıkış yapılsın mı?',

//mtConfirmation, [mbNo, mbYes], 0)= mrNo then

//Close;

end;

procedure TForm1.Image9Click(Sender: TObject);

begin

Form5.Show;

end;

end.

//---------------------------------------------Unit2.pas--------------------

unit Unit2;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, StdCtrls, ComCtrls, ExtCtrls, JvComponentBase, JvFormMagnet,

jpeg;

type

TForm2 = class(TForm)

RichEdit1: TRichEdit;

Image1: TImage;

JvFormMagnet1: TJvFormMagnet;

Image4: TImage;

procedure FormCreate(Sender: TObject);

procedure Image1DblClick(Sender: TObject);

procedure RichEdit1KeyPress(Sender: TObject; var Key: Char);

procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

procedure Image4Click(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form2: TForm2;

implementation

uses Unit1;

{$R *.dfm}

procedure TForm2.FormCreate(Sender: TObject);

begin

form1.show;

end;

procedure TForm2.Image1DblClick(Sender: TObject);

begin

form2.close;

end;

procedure TForm2.RichEdit1KeyPress(Sender: TObject; var Key: Char);

begin

if key = #13 then

form2.close;

end;

procedure TForm2.Image1MouseDown(Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

begin

ReleaseCapture;

Form2.perform(WM_SYSCOMMAND, $F012, 0);

end;

//end;

procedure TForm2.Image4Click(Sender: TObject);

begin

form2.close;

end;

end.

//---------------------------------------------Unit3.pas--------------------

unit Unit3;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, ComCtrls, StdCtrls,ExtActns, ExtCtrls, JvComponentBase,

JvFormMagnet;

type

TForm3 = class(TForm)

Timer1: TTimer;

JvFormMagnet1: TJvFormMagnet;

Image1: TImage;

ProgressBar1: TProgressBar;

procedure URLOnDownloadProgress

(Sender: TDownLoadURL;

Progress, ProgressMax: Cardinal;

StatusCode: TURLDownloadStatus;

StatusText: String; var Cancel: Boolean) ;

procedure FormCreate(Sender: TObject);

procedure Timer1Timer(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form3: TForm3;

dosya,dosyadi:String;

implementation

uses Unit1;

{$R *.dfm}

procedure TForm3.URLOnDownloadProgress;

begin

form1.JvSpecialProgress1.Maximum:=ProgressMax;

form1.JvSpecialProgress1.Position:= Progress;

ProgressBar1.Max:= ProgressMax;

ProgressBar1.Position:= Progress;

// Free; // Form3.Close;

end;

procedure DoDownload;

begin

with TDownloadURL.Create(nil) do

try

URL:=dosya;//'http://www.grantfullen.com/Delta Force Black Hawk Down.zip';

FileName :=dosyadi;// 'c:dforce.zip';

OnDownloadProgress := Form3.URLOnDownloadProgress;

ExecuteTarget(nil) ;

finally

end;

procedure TForm3.FormCreate(Sender: TObject);

begin

dosya:=form1.Memo1.Lines.Text;

dosyadi:=IncludeTrailingPathDelimiter(ExtractFilePath(Application.ExeName)) + 'temp.xml';

DoDownload;

//form1.ProgressBar1.Position:=0; if FileExists(form1.Memo1.Lines.Text) then

///DeleteFile(form1.Memo1.Lines.Text);

end;

procedure TForm3.Timer1Timer(Sender: TObject);

begin

image1.Refresh;

if progressbar1.Position=100 then

progressbar1.Position:=0;

form1.JvSpecialProgress1.Position:=0;

form3.Close;

end;

end.

//---------------------------------------------Unit4.pas--------------------

unit Unit4;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, JvComponentBase, JvFormTransparent, JvExControls, JvaScrollText,

ExtCtrls, JvScrollText, jpeg;

type

TForm4 = class(TForm)

JvTransparentForm1: TJvTransparentForm;

scrol2: TJvScrollText;

Image1: TImage;

JvScrollText1: TJvScrollText;

Image4: TImage;

procedure Image1DblClick(Sender: TObject);

procedure Image4Click(Sender: TObject);

procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form4: TForm4;

implementation

{$R *.dfm}

procedure TForm4.Image1DblClick(Sender: TObject);

begin

form4.Close;

end;

procedure TForm4.Image4Click(Sender: TObject);

begin

form4.Close;

end;

procedure TForm4.Image1MouseDown(Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

begin

ReleaseCapture;

Form4.perform(WM_SYSCOMMAND, $F012, 0);

end;

end.

//---------------------------------------------Unit5.pas--------------------

unit Unit5;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, ComCtrls, JvExComCtrls, JvProgressBar, JvDBProgressBar, Grids,

DBGrids, JvExDBGrids, JvDBGrid, JvDBUltimGrid, JvExControls,

JvScrollText, jpeg, ExtCtrls, DB, ADODB, DBCtrls, StdCtrls, Mask, Menus;

type

TForm5 = class(TForm)

DBEdit1: TDBEdit;

DBEdit2: TDBEdit;

DBNavigator1: TDBNavigator;

ADOTable1: TADOTable;

DataSource1: TDataSource;

Image1: TImage;

Image4: TImage;

scrol2: TJvScrollText;

JvDBUltimGrid1: TJvDBUltimGrid;

JvDBProgressBar1: TJvDBProgressBar;

DBLookupComboBox1: TDBLookupComboBox;

DBEdit3: TDBEdit;

PopupMenu1: TPopupMenu;

HaberleriAl1: TMenuItem;

procedure Image4Click(Sender: TObject);

procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

procedure HaberleriAl1Click(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form5: TForm5;

implementation

uses Unit1;

{$R *.dfm}

procedure TForm5.Image4Click(Sender: TObject);

begin

form5.Close;

end;

procedure TForm5.Image1MouseDown(Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

begin

ReleaseCapture;

Form5.perform(WM_SYSCOMMAND, $F012, 0);

end;

procedure TForm5.HaberleriAl1Click(Sender: TObject);

begin

form1.BitBtn1.Click();

end;

end.

//---------------------------------------------Unit6.pas--------------------

unit Unit6;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, ExtCtrls, OleCtrls, WMPLib_TLB, jpeg, MPlayer,ShellAPI,MMSystem,

JvExControls, JvScrollText, JvComponentBase, JvFormMagnet, StdCtrls,

JvExStdCtrls, JvScrollBar;

type

TForm6 = class(TForm)

Image4: TImage;

Image2: TImage;

Timer1: TTimer;

scrol2: TJvScrollText;

JvFormMagnet1: TJvFormMagnet;

procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

procedure Image4Click(Sender: TObject);

procedure Image1Click(Sender: TObject);

procedure Image2Click(Sender: TObject);

procedure Timer1Timer(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form6: TForm6;

implementation

uses Unit1, Unit7, JvPlayListMainFormU;

{$R *.dfm}

procedure TForm6.Image1MouseDown(Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

begin

ReleaseCapture;

Form6.perform(WM_SYSCOMMAND, $F012, 0);

end;

procedure TForm6.Image4Click(Sender: TObject);

begin

form6.Close;

end;

procedure TForm6.Image1Click(Sender: TObject);

begin

Form7.Show;

end;

procedure TForm6.Image2Click(Sender: TObject);

begin

Form7.Show;

end;

procedure TForm6.Timer1Timer(Sender: TObject);

begin

// mediaplayer1.Display:=panel1;

// mediaplayer1.Display.Height:=panel1.Height;

//mediaplayer1.Display.Width:=panel1.Width

end;

end.

//---------------------------------------------Unit7.pas--------------------

unit Unit7;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, StdCtrls, JvExStdCtrls, JvListBox, JvPlaylist, jpeg, ExtCtrls,

ActnList, Menus, JvExControls, JvScrollText, JvComponentBase,

JvFormMagnet, JvScrollBar, MPlayer, JvColorTrackbar, JvSoundControl,

ComCtrls ,ShellAPI, SXPNGUtils;

type

TForm7 = class(TForm)

Image1: TImage;

Image4: TImage;

ActionList1: TActionList;

Open: TAction;

Delete: TAction;

Exit: TAction;

DeleteDead: TAction;

SortSong: TAction;

SortPah: TAction;

SortPathI: TAction;

SortSongNameInverted: TAction;

RandomOrder: TAction;

Reverse: TAction;

SelectAll: TAction;

UnselectAll: TAction;

InvSelect: TAction;

MoveUp: TAction;

MoveDown: TAction;

OpenDialog1: TOpenDialog;

GroupBox1: TGroupBox;

Label1: TLabel;

JvPlaylist1: TJvPlaylist;

scrol2: TJvScrollText;

Timer1: TTimer;

ScrollBar1: TJvScrollBar;

MediaPlayer1: TMediaPlayer;

ses: TJvSoundControl;

kontrol: TTrackBar;

Panel1: TPanel;

PopupMenu1: TPopupMenu;

PopupMenu2: TPopupMenu;

PopupMenu3: TPopupMenu;

PopupMenu4: TPopupMenu;

A1: TMenuItem;

Sil1: TMenuItem;

N4: TMenuItem;

k1: TMenuItem;

NumaralarGster1: TMenuItem;

UzantlarGster1: TMenuItem;

SrcHarfleriniGster1: TMenuItem;

Image2: TImage;

Image3: TImage;

Image5: TImage;

Image6: TImage;

BozukDosyalarSil1: TMenuItem;

Sralama1: TMenuItem;

DizineGre1: TMenuItem;

DntrlenDizineGre1: TMenuItem;

arkAdnaGre1: TMenuItem;

DntrlenarkAdnaGre1: TMenuItem;

N5: TMenuItem;

RastgeleSrala1: TMenuItem;

SralamayTersevir1: TMenuItem;

mnSe1: TMenuItem;

HibiriniSeme1: TMenuItem;

DierleriniSe1: TMenuItem;

N6: TMenuItem;

SeileniYukarTa1: TMenuItem;

SeileniAaTa1: TMenuItem;

Edit1: TEdit;

sure: TLabel;

simdi: TLabel;

kalan: TLabel;

procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

procedure ScrollBar1Change(Sender: TObject);

procedure kontrolChange(Sender: TObject);

procedure JvPlaylist1DblClick(Sender: TObject);

procedure JvPlaylist1DragOver(Sender, Source: TObject; X, Y: Integer;

State: TDragState; var Accept: Boolean);

procedure FormCreate(Sender: TObject);

procedure Timer1Timer(Sender: TObject);

procedure Panel1DblClick(Sender: TObject);

procedure A1Click(Sender: TObject);

procedure Sil1Click(Sender: TObject);

procedure k1Click(Sender: TObject);

procedure NumaralarGster1Click(Sender: TObject);

procedure UzantlarGster1Click(Sender: TObject);

procedure SrcHarfleriniGster1Click(Sender: TObject);

procedure BozukDosyalarSil1Click(Sender: TObject);

procedure DizineGre1Click(Sender: TObject);

procedure arkAdnaGre1Click(Sender: TObject);

procedure DntrlenDizineGre1Click(Sender: TObject);

procedure DntrlenarkAdnaGre1Click(Sender: TObject);

procedure RastgeleSrala1Click(Sender: TObject);

procedure SralamayTersevir1Click(Sender: TObject);

procedure mnSe1Click(Sender: TObject);

procedure HibiriniSeme1Click(Sender: TObject);

procedure DierleriniSe1Click(Sender: TObject);

procedure SeileniYukarTa1Click(Sender: TObject);

procedure SeileniAaTa1Click(Sender: TObject);

procedure Image4Click(Sender: TObject);

procedure CurrentPlay(ARTIST: string;bStop:boolean);

private

{ Private declarations }

procedure FileIsDropped(var Msg: TMessage); message WM_DropFiles;

public

{ Public declarations }

end;

var

Form7: TForm7;

maske:String;

OldLBWindowProc: TWndMethod;

implementation

uses Unit6, Unit1;

{$R *.dfm}

procedure TForm7.Image1MouseDown(Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

begin

ReleaseCapture;

Form7.perform(WM_SYSCOMMAND, $F012, 0);

end;

procedure TForm7.ScrollBar1Change(Sender: TObject);

begin

ScrollBar1.OnChange := nil;

ScrollBar1.Position := MediaPlayer1.Position;

ScrollBar1.OnChange := ScrollBar1Change;

end;

procedure TForm7.kontrolChange(Sender: TObject);

begin

ses.Wave.Volume:=kontrol.Position;

end;

procedure TForm7.JvPlaylist1DblClick(Sender: TObject);

begin

//if JvPlayList1.ItemIndex<>-1 then

//form6.MediaPlayer1.Stop;

form6.Timer1.Enabled := false;

Label1.Caption := JvPlayList1.Items[JvPlayList1.ItemIndex];

scrol2.Active:=false;

form6.scrol2.Active:=false;

scrol2.Items.Clear;

form6.scrol2.Items.Clear;

scrol2.Items.Add(Label1.Caption);

form6.scrol2.Items.Add(Label1.Caption);

scrol2.Active:=true;

form6.scrol2.Active:=true;

MediaPlayer1.FileName:=label1.Caption;

MediaPlayer1.Open;

MediaPlayer1.Play;

ScrollBar1.Max := MediaPlayer1.Length;

ScrollBar1.Position := 0;

Timer1.Enabled := true;

end;

procedure TForm7.JvPlaylist1DragOver(Sender, Source: TObject; X,

Y: Integer; State: TDragState; var Accept: Boolean);

begin

accept:=true;

end;

procedure TForm7.FormCreate(Sender: TObject);

begin

DragAcceptFiles(Handle, true);

end;

procedure TForm7.FileIsDropped(var Msg: TMessage);

var

Drop: THandle;

FileName: array[0..254] of Char;

NumberOfFiles: integer;

FileCounter: integer;

begin

Drop:= Msg.WParam;

// If the indexno is 4294967295, the number of dragged items will be retrieved

// with DragQueryFile command.

// ( The API-manual tells me that the indexno should be -1, which is not a

// possible Cardinal-value. 4294967295 is the maximum Cardinal-value, and it

// seems to work fine!? Could anybody give me a hint about this? )

NumberOfFiles:= DragQueryFile(Drop, 4294967295, FileName, 254);

for FileCounter:= 0 to NumberOfFiles - 1 do

begin

// Copy the filename,-s with the corresponding value to the buffer FileName.

DragQueryFile(Drop, FileCounter, FileName, 254);

// Write the filename (without path) to Memo.

//Memo1.Lines.Add(ExtractFileName(FileName));

jvplaylist1.Items.Add(ExtractFileName(FileName));

end;

// Release memory that Windows allocated for use in transferring filenames to

// the application.

DragFinish(Drop);

end;

function MilliSecondsToString(MilliSeconds: integer): string;

var i1, i2: integer;

begin

i1:=(MilliSeconds div 1000) div 60;

i2:=(MilliSeconds div 1000)-(i1*60);

Result:=FormatFloat('00',i1)+':'+FormatFloat('00',i2);

end;

procedure TForm7.Timer1Timer(Sender: TObject);

var

artist:String;

begin

Mediaplayer1.Display:=panel1;

mediaplayer1.DisplayRect:=rect(5,5,panel1.Width-10,panel1.Height-10);

ScrollBar1.OnChange := nil;

ScrollBar1.Position := MediaPlayer1.Position;

ScrollBar1.OnChange := ScrollBar1Change;

artist:=edit1.text;

edit1.Text:=extractfilename(mediaplayer1.FileName);

CurrentPlay(edit1.Text,true);

sure.Caption:=MilliSecondsToString(Mediaplayer1.Length);

simdi.Caption:=MilliSecondsToString(mediaplayer1.position);

kalan.Caption:=MilliSecondsToString(mediaplayer1.Length-mediaplayer1.Position);

end;

procedure TForm7.Panel1DblClick(Sender: TObject);

begin

//mediaplayer1.

end;

procedure tform7.CurrentPlay(ARTIST: string;bStop:boolean);

var

handleMSN:THandle;

structCopy:TCopyDataStruct;

stringBuffer:array [0..127] of WideChar;

begin

artist:=Edit1.Text;

ARTIST:= copy(ARTIST,1,75);

FillChar(stringBuffer,SizeOf(stringBuffer),#0);

if Not bStop then

StringToWideChar('Music'+'1'+''+'{0}'+''+ARTIST+''+'WMContentID'+#0,@stringBuffer[0],128)

else // parça stop edildi ise

StringToWideChar('Music'+'0'+''+'{0}'+''+ARTIST+''+'WMContentID'+#0,@stringBuffer[0],128);

// orjinal hali

StringToWideChar('Music'+'1'+''+'{0} - {1}'+''+ARTIST+''+''+''+'WMContentID'+#0,@stringBuffer[0],128);

ZeroMemory(@structCopy,SizeOf(TCopyDataStruct));

with structCopy do

begin

cbData:=SizeOf(stringBuffer);

dwData:=$547;

lpData:=@stringBuffer[0];

end;

handleMSN:=FindWindowEx(0,0,'MsnMsgrUIManager',nil);

while handleMSN <> 0 do

begin

SendMessage(handleMSN,WM_COPYDATA,0,Integer(@structCopy));

handleMSN:=FindWindowEx(0,handleMSN,'MsnMsgrUIManager',nil);

end;

procedure TForm7.A1Click(Sender: TObject);

begin

if OpenDialog1.Execute then

JvPlayList1.AddItems(OpenDialog1.Files);

end;

procedure TForm7.Sil1Click(Sender: TObject);

begin

JvPlayList1.DeleteSelected;

end;

procedure TForm7.k1Click(Sender: TObject);

begin

Application.Terminate;

end;

procedure TForm7.NumaralarGster1Click(Sender: TObject);

begin

with Sender as TMenuItem do

begin

Checked := not Checked;

JvPlayList1.ShowNumbers := Checked;

end;

procedure TForm7.UzantlarGster1Click(Sender: TObject);

begin

with Sender as TMenuItem do

begin

Checked := not Checked;

JvPlayList1.ShowExtension := Checked;

end;

procedure TForm7.SrcHarfleriniGster1Click(Sender: TObject);

begin

with Sender as TMenuItem do

begin

Checked := not Checked;

JvPlayList1.ShowDrive := Checked;

end;

procedure TForm7.BozukDosyalarSil1Click(Sender: TObject);

begin

JvPlayList1.DeleteDeadFiles;

end;

procedure TForm7.DizineGre1Click(Sender: TObject);

begin

JvPlayList1.SortByPath;

end;

procedure TForm7.arkAdnaGre1Click(Sender: TObject);

begin

JvPlayList1.SortBySongName;

end;

procedure TForm7.DntrlenDizineGre1Click(Sender: TObject);

begin

JvPlayList1.SortByPathInverted;

end;

procedure TForm7.DntrlenarkAdnaGre1Click(Sender: TObject);

begin

JvPlayList1.SortBySongNameInverted;

end;

procedure TForm7.RastgeleSrala1Click(Sender: TObject);

begin

JvPlayList1.RandomOrder;

end;

procedure TForm7.SralamayTersevir1Click(Sender: TObject);

begin

JvPlayList1.ReverseOrder;

end;

procedure TForm7.mnSe1Click(Sender: TObject);

begin

JvPlayList1.SelectAll;

end;

procedure TForm7.HibiriniSeme1Click(Sender: TObject);

begin

JvPlayList1.UnselectAll;

end;

procedure TForm7.DierleriniSe1Click(Sender: TObject);

begin

JvPlayList1.InvertSelection;

end;

procedure TForm7.SeileniYukarTa1Click(Sender: TObject);

begin

JvPlayList1.MoveSelectedUp;

end;

procedure TForm7.SeileniAaTa1Click(Sender: TObject);

begin

JvPlayList1.MoveSelectedDown;

end;

procedure TForm7.Image4Click(Sender: TObject);

begin

form7.Close;

end;

end.

Delphi - .....................................

Program Çalışırken Kod İle Veritabanı Yaratmak (DBASE - ASCII - MSACCESS [*.mdb])

// Delphi programcılığndan daha çok programlama ile uraşan arkadaşlarda bilirlerki

//yazılan bşir programda her ne kadar hali hazırda yapılmış bir veritabanını kullansakta

// bazı zamanlar programın içinden kendi veritabanımızı oluşturma gereksinimi duyarız.

//bunu kodbankta araştırdım ama bulamadım.bu yüzdende kendim bişiler yapabilirmiyim diye

//biraz uğraştım vede aşağıdaki kodlar ortaya çıktı.

//umarım bir arkadaşımızın işine yarar.Bol procedur le başlayan end ile sonlanan kodlar dileğiyle

uses

ComObj;

// ADOX ile yaratmak

function mdbyarat(FileName: string): string;

var

cat: OLEVariant;

begin

Result := '';

try

cat := CreateOleObject('ADOX.Catalog');

cat.Create('Provider=Microsoft.Jet.OLEDB.4.0;Data Source=' + FileName + ';');

cat := NULL;

except

on e: Exception do Result := e.message;

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

mdbyarat('c:Testdb.mdb');

end;

//Sadece DBASE yada ASCII veritabanı yaratmak istiyorsanız

procedure CreateATable(DBName, //Alias yada dizin

TblName : String); //Yarataılacak Tablo Adı

TblType : TTableType); //ttDefault, ttParadox, ttDBase, ttASCII (tablo türü)

var

tablo : TTable;

begin

tablo := TTable.Create(Application);

with tbl do begin

Active := False;

DatabaseName := DBName;

TableName := TblName;

TableType := TblType;

with FieldDefs do begin

Clear;

Add('Soyadi', ftString, 30, False); //30 değeri alanın uzunluğu [ftString değeri de alanın string tipinde olacağıdır]

Add('Adi', ftString, 30, False);

Add('Adres1', ftString, 40, False);

Add('Adres2', ftString, 40, False);

Add('Sehir', ftString, 30, False);

Add('Cad', ftString, 2, False);

Add('Alan_Kodu', ftString, 10, False);

end;

{Tabloya birincil anahtar ekle}

with IndexDefs do begin

Clear;

Add('Field1Index', 'Soyadi;Adi', [ixPrimary, ixUnique]); {bunu istediğiniz bir alan olarak atayabilirsiniz}

end;

CreateTable; {Tabloyu Yarat}

end;

Delphi - .....................................

FİLE TRANSFER SERVER ve CLİENT

/// BU KISIM Gönderici tarafını dinler gelen paketleri toplayıp belirlediğiniz dizine kopyalar

///Clientide aşağıdadır dosya transferi çok yüksek hızdadır

///şu ana kadar gördüğüm en hızlı dosya gönderici ve alıcıdır

/// Hiçbir zamazingo componente ihtiyaç duyulmaz

/// **********************COMMANDX ***************************

***********************SERVER KISMI************************************

unit mainsrvr;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,

ComCtrls, StdCtrls, Buttons, ScktComp;

type

TFileInfo = packed record

FileLength : Integer;

FileName : string[128];

end;

TFileServer = class(TForm)

LabPort: TLabel;

EdPort: TEdit;

EdDir: TEdit;

LabDir: TLabel;

Statbar: TStatusBar;

ServerSocket: TServerSocket;

BtnListen: TButton;

BtnStopListen: TButton;

procedure BtnListenClick(Sender: TObject);

procedure BtnStopListenClick(Sender: TObject);

procedure ServerSocketGetThread(Sender: TObject;

ClientSocket: TServerClientWinSocket;

var SocketThread: TServerClientThread);

private

{ Private declarations }

public

end;

{

This thread is executed by the server for each client connection

}

TServerRcvThread = class(TServerClientThread)

private

FStatus : string;

FDir : string;

protected

procedure ClientExecute; override;

public

procedure SetStatus;

property Dir : string read FDir write FDir;

end;

var

FileServer : TFileServer;

implementation

{$R *.DFM}

{

User has clicked "Listen" button.

Activate server's listening socket on cpecified port.

}

procedure TFileServer.BtnListenClick(Sender: TObject);

begin

ServerSocket.ServerType := stThreadBlocking;

ServerSocket.Port := StrToInt( EdPort.Text );

ServerSocket.Active := True;

BtnListen.Enabled := not ServerSocket.Active;

BtnStopListen.Enabled := ServerSocket.Active

end;

{

User has clicked "Stop Listening" button

}

procedure TFileServer.BtnStopListenClick(Sender: TObject);

begin

ServerSocket.Active := False;

BtnListen.Enabled := not ServerSocket.Active;

BtnStopListen.Enabled := ServerSocket.Active

end;

{

OnGetThread handler for TServerSocket

The server is blocking, hence creates new thread for each client connection.

Here I force the server to use my own thread class instead of standard one.

}

procedure TFileServer.ServerSocketGetThread(Sender: TObject;

ClientSocket: TServerClientWinSocket;

var SocketThread: TServerClientThread);

begin

// Create new thread (a descendant of TServerClientThread)

// The thred is created in suspended state, to set up

// Dir property before execution starts actually.

SocketThread := TServerRcvThread.Create( True, ClientSocket );

// Save target directory into thread's property

// (to use it within a thread).

TServerRcvThread(SocketThread).Dir := EdDir.Text;

SocketThread.Resume;

end;

{ TServerRcvThread }

{

TServerRcvThread thread procedure.

Its execution begins immediately after the server creates client's

thread in OnGetThreadHandler;

}

procedure TServerRcvThread.ClientExecute;

var

SockStream : TWinSocketStream;

FileInfo : TFileInfo;

FileStream : TFileStream;

RcvBuf : array[0..255] of Byte;

nRead : Integer;

nToRead : Integer;

nTotal : Integer;

begin

FStatus := 'Unknown error';

// Prepare blocking stream socket

SockStream := TWinSocketStream.Create( ClientSocket, 10000 );

try

// Wait until data becomes available at our endpoint.

if SockStream.WaitForData(1000) then begin

// Read info header

nRead := SockStream.Read( FileInfo, SizeOf(FileInfo) );

if (nRead = SizeOf(FileInfo)) then begin

// Prepare destination file

nTotal := 0;

FileStream := TFileStream.Create( FDir + '' + FileInfo.FileName,

fmCreate );

try

// Read file body by realatively small blocks

while(nTotal < FileInfo.FileLength) do begin

// How many bytes shall we read?

nToRead := (FileInfo.FileLength - nTotal);

if (nToRead > SizeOf(RcvBuf)) then

nToRead := SizeOf(RcvBuf);

// Read from blocking socket

nRead := SockStream.Read( RcvBuf, nToRead );

if (nRead = 0) then Exit; // timeout error

nTotal := nTotal + nRead;

// Store next received chunk in the destination file

FileStream.Write( RcvBuf, nRead );

end;

finally

FileStream.Free;

end;

// Determine final status of the transfer operation

if (nTotal = FileInfo.FileLength) then

FStatus := 'File ' + FileInfo.FileName + ' received ('

+ IntToStr(nTotal) + ' bytes)'

else

FStatus := 'File ' + FileInfo.FileName + ' error ('

+ IntToStr(nTotal) + ' bytes)';

end

// could not even receive a file info header

else

FStatus := 'File info header error';

end

// No incoming data detected - abort connection.

else begin

FStatus := 'Client delay error';

ClientSocket.Close; // causes "server aborted

Terminate; // connection" on client's side

end;

finally

SockStream.Free;

Synchronize( SetStatus ); // display transfer status

end;

procedure TServerRcvThread.SetStatus;

begin

FileServer.StatBar.SimpleText := FStatus;

end;

end.

*************************** CLİENT KISMI*****************************

unit mainclnt;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,

ComCtrls, StdCtrls, Buttons, ScktComp;

type

TFileClient = class(TForm)

EdAddress: TEdit;

LabAddr: TLabel;

LabPort: TLabel;

EdPort: TEdit;

EdFile: TEdit;

LabFile: TLabel;

BtnTransfer: TButton;

Statbar: TStatusBar;

ClientSocket: TClientSocket;

procedure BtnTransferClick(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

TFileInfo = packed record

FileLength : Integer;

FileName : string[128];

end;

var

FileClient: TFileClient;

implementation

{$R *.DFM}

{

User clicked "Transfer" button.

Try to connect to specified server and transfer specified file.

}

procedure TFileClient.BtnTransferClick(Sender: TObject);

var

SockStream : TWinSocketStream;

FileStream : TFileStream;

FileInfo : TFileInfo;

BytesSent : Longint;

begin

try

// Prepare source file to transfer

FileStream := TFileStream.Create( EdFile.Text, fmOpenRead );

try

FileInfo.FileLength := FileStream.Size;

FileInfo.FileName := ExtractFileName( EdFile.Text );

// Prepare socket

with ClientSocket do begin

ClientType := ctBlocking;

Address := EdAddress.Text;

Port := StrToInt( EdPort.Text );

end;

// Connect to server

ClientSocket.Open();

try

// Perpeare socket stream

SockStream :=TWinSocketStream.Create( ClientSocket.Socket, 60000 );

try

// Transfer info header

BytesSent := SockStream.Write( FileInfo, SizeOf(FileInfo) );

// Transfer file body

if (BytesSent <> 0) then begin

BytesSent := SockStream.CopyFrom( FileStream, FileStream.Size );

Statbar.SimpleText := 'Transferred ' + IntToStr( BytesSent )

+ ' from ' + FileInfo.FileName;

end

else

Statbar.SimpleText := 'Header transfer error';

finally

SockStream.Free;

end;

finally

// Disconnect from server

ClientSocket.Close();

end;

finally

FileStream.Free;

end;

except

On E : Exception do

Statbar.SimpleText := E.Message;

end;

end.

//////// COMMANDX///*******************

Delphi - .....................................