Delphi arşivleri - Yakup ULUTAŞ

Delphi ile Youtube data API işlemleri

13 Mart 201914 Mart 2019 yhackup0

Merhabalar, Youtube’un bize sağladığı apileri Delphi uygulaması ile nasıl kullanabiliriz (in) cevabı bu yazıda olacak. Öncelikle Buradaki youtube developer sitesinden bir api key edinmeniz gerekiyor. Api keyinizi aldıktan sonra aşağıdaki hazırladığımUV3 .pas dosyasını inceleyebilirsiniz. nerede ne yaptığımı uzun uzun anlatmaya zamanım yok ancak sorunuz olur ise aşağıdan sorabilirsiniz. Uygulamamızın ilk ekran görüntüsü. […]

Devamını Oku

Müzik İndirme Uygulaması

10 Ocak 201910 Nisan 2019 yhackup0

Merhabalar, Basit bir Youtube’dan müzik indirme uygulaması ve kaynak kodları. Not: Ülkemizde mp3 indirmek yasal değildir. Yandex.Disk’ten İndir

unit Ytindir;
interface
uses
Winapi.Windows,
System.SysUtils,
StrUtils,
shellapi,
System.json,
Vcl.Clipbrd,
Vcl.Forms,
Vcl.Dialogs,
Vcl.StdCtrls,
clHttp,
UYoutubeApi,
clHttpHeader,
IdHTTP,
System.Classes,
Vcl.Controls,
Vcl.ExtCtrls, IdTCPClient, IdTCPConnection, IdComponent, IdBaseComponent;
const
youtubeapiKey = 'AIzaSyDMQHKxxxxxxxxxxxxxxxxxxxxxxxx';
type
TForm1 = class(TForm)
YoutubeUrl: TEdit;
IdHTTP1: TIdHTTP;
Memo1: TMemo;
Panel1: TPanel;
Button2: TButton;
procedure Button1Click(Sender: TObject);
procedure Download(link: string);
procedure GetMp3(link: String; path: string = '');
function GetName(val: string): String;
procedure YoutubeUrlClick(Sender: TObject);
procedure Logged(text: string);
procedure Panel1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
wkod: string;
implementation
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
var
i1: Integer;
wkod: string;
begin
if Pos('youtube', YoutubeUrl.text) > 1 then
begin
i1 := Pos('watch?v=', YoutubeUrl.text) + 8;
wkod := Copy(YoutubeUrl.text, i1, 11);
end
else
begin
i1 := Pos('youtu.be', YoutubeUrl.text) + 9;
wkod := Copy(YoutubeUrl.text, i1, 11);
end;
Download(wkod);
end;
procedure TForm1.Download(link: string);
var
url: String;
begin
url := link;
TThread.CreateAnonymousThread(
procedure
var
yt: TYoutubeMp3Api;
begin
yt := TYoutubeMp3Api.Create;
GetMp3(yt.GetMp3link(url));
end).Start;
end;
procedure TForm1.GetMp3(link, path: string);
var
Resp: TMemoryStream;
MyHttp: TclHttp;
filename: String;
begin
Resp := TMemoryStream.Create;
MyHttp := TclHttp.Create(nil);
try
Logged('İndiriliyor...');
MyHttp.Get(link, Resp);
Logged('İndirildi.');
filename := Ifthen(Trim(Caption) = '', 'UnknownName', Caption);
filename := filename.Replace('"', '');
Resp.Position := 0;
Resp.SaveToFile(ExtractFilePath(Application.ExeName) + '/' + filename + '.mp3');
Logged(ExtractFilePath(Application.ExeName) + '/' + filename + '.mp3');
finally
Resp.Free;
MyHttp.Free;
end; // pdfindir
TThread.Queue(nil,
procedure
begin
ShellExecute(0, 'open', Pwidechar(ExtractFilePath(Application.ExeName) + '/'), nil, nil, SW_SHOWNORMAL);
end);
end;
function GetInfo(watch: String): String;
var
Response: TMemoryStream;
mHttp: TclHttp;
Ts: TStringList;
url: String;
begin
url := 'https://www.googleapis.com/youtube/v3/videos?part=snippet&id=' + watch + '&key=' + youtubeapiKey;
Response := TMemoryStream.Create;
mHttp := TclHttp.Create(nil);
Ts := TStringList.Create;
try
mHttp.Get(url, Response);
mHttp.TimeOut := 5000;
Response.Position := 0;
Ts.LoadFromStream(Response, TEncoding.UTF8);
Result := Ts.text;
finally
FreeAndNil(Ts);
FreeAndNil(Response);
FreeAndNil(mHttp);
end;
end;
function TForm1.GetName(val: string): String;
var
json, item, snippet: TJSONObject;
items: TJSONArray;
begin
try
json := TJSONObject.ParseJSONValue(TEncoding.UTF8.GetBytes(GetInfo(val)), 0) as TJSONObject;
items := TJSONObject.ParseJSONValue(TEncoding.UTF8.GetBytes(json.GetValue('items').ToString), 0) as TJSONArray;
item := items.Get(0) as TJSONObject;
snippet := item.GetValue('snippet') as TJSONObject;
Result := StringReplace(snippet.GetValue('title').ToString, '"', EmptyStr, [rfReplaceAll]);
except
on E: Exception do
Result := '';
end;
end;
procedure TForm1.Logged(text: string);
begin
TThread.Queue(nil,
procedure
begin
Memo1.Lines.Add(text);
end);
end;
procedure TForm1.Panel1Click(Sender: TObject);
begin
ShellExecute(Handle, 'open', 'blog.yakupulutas.com/muzik-indirme-uygulamasi', nil, nil, SW_SHOW);
end;
procedure TForm1.YoutubeUrlClick(Sender: TObject);
var
i1: Integer;
begin
YoutubeUrl.text := Clipboard.AsText;
if Length(YoutubeUrl.text) < 8 then
Exit;
if Pos('youtube', YoutubeUrl.text) > 1 then
begin
i1 := Pos('watch?v=', YoutubeUrl.text) + 8;
wkod := Copy(YoutubeUrl.text, i1, 11);
end
else
begin
i1 := Pos('youtu.be', YoutubeUrl.text) + 9;
wkod := Copy(YoutubeUrl.text, i1, 11);
end;
Logged('watch : ' + wkod);
Caption := GetName(wkod);
Logged('Video Name : ' + Caption);
end;
end.

1

2

3

4

5

6

7

8

9

10

11

12

13

14

15

16

17

18

19

20

21

22

23

24

25

26

27

28

29

30

31

32

33

34

35

36

37

38

39

40

41

42

43

44

45

46

47

48

49

50

51

52

53

54

55

56

57

58

59

60

61

62

63

64

65

66

67

68

69

70

71

72

73

74

75

76

77

78

79

80

81

82

83

84

85

86

87

88

89

90

91

92

93

94

95

96

97

98

99

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

129

130

131

132

133

134

135

136

137

138

139

140

141

142

143

144

145

146

147

148

149

150

151

152

153

154

155

156

157

158

159

160

161

162

163

164

165

166

167

168

169

170

171

172

173

174

175

176

177

178

179

180

181

182

183

184

185

186

187

188

189

190

191

192

193

194

195

196

197

198

199

200

201

202

203

204

205

206

207

208

209

210

unit Ytindir;

interface

uses

Winapi.Windows,

System.SysUtils,

StrUtils,

shellapi,

System.json,

Vcl.Clipbrd,

Vcl.Forms,

Vcl.Dialogs,

Vcl.StdCtrls,

clHttp,

UYoutubeApi,

clHttpHeader,

IdHTTP,

System.Classes,

Vcl.Controls,

Vcl.ExtCtrls, IdTCPClient, IdTCPConnection, IdComponent, IdBaseComponent;

const

youtubeapiKey = 'AIzaSyDMQHKxxxxxxxxxxxxxxxxxxxxxxxx';

type

TForm1 = class(TForm)

YoutubeUrl: TEdit;

IdHTTP1: TIdHTTP;

Memo1: TMemo;

Panel1: TPanel;

Button2: TButton;

procedure Button1Click(Sender: TObject);

procedure Download(link: string);

procedure GetMp3(link: String; path: string = '');

function GetName(val: string): String;

procedure YoutubeUrlClick(Sender: TObject);

procedure Logged(text: string);

procedure Panel1Click(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form1: TForm1;

wkod: string;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);

var

i1: Integer;

wkod: string;

begin

if Pos('youtube', YoutubeUrl.text) > 1 then

begin

i1 := Pos('watch?v=', YoutubeUrl.text) + 8;

wkod := Copy(YoutubeUrl.text, i1, 11);

end

else

begin

i1 := Pos('youtu.be', YoutubeUrl.text) + 9;

wkod := Copy(YoutubeUrl.text, i1, 11);

end;

Download(wkod);

end;

procedure TForm1.Download(link: string);

var

url: String;

begin

url := link;

TThread.CreateAnonymousThread(

procedure

var

yt: TYoutubeMp3Api;

begin

yt := TYoutubeMp3Api.Create;

GetMp3(yt.GetMp3link(url));

end).Start;

end;

procedure TForm1.GetMp3(link, path: string);

var

Resp: TMemoryStream;

MyHttp: TclHttp;

filename: String;

begin

Resp := TMemoryStream.Create;

MyHttp := TclHttp.Create(nil);

try

Logged('İndiriliyor...');

MyHttp.Get(link, Resp);

Logged('İndirildi.');

filename := Ifthen(Trim(Caption) = '', 'UnknownName', Caption);

filename := filename.Replace('"', '');

Resp.Position := 0;

Resp.SaveToFile(ExtractFilePath(Application.ExeName) + '/' + filename + '.mp3');

Logged(ExtractFilePath(Application.ExeName) + '/' + filename + '.mp3');

finally

Resp.Free;

MyHttp.Free;

end; // pdfindir

TThread.Queue(nil,

procedure

begin

ShellExecute(0, 'open', Pwidechar(ExtractFilePath(Application.ExeName) + '/'), nil, nil, SW_SHOWNORMAL);

end);

end;

function GetInfo(watch: String): String;

var

Response: TMemoryStream;

mHttp: TclHttp;

Ts: TStringList;

url: String;

begin

url := 'https://www.googleapis.com/youtube/v3/videos?part=snippet&id=' + watch + '&key=' + youtubeapiKey;

Response := TMemoryStream.Create;

mHttp := TclHttp.Create(nil);

Ts := TStringList.Create;

try

mHttp.Get(url, Response);

mHttp.TimeOut := 5000;

Response.Position := 0;

Ts.LoadFromStream(Response, TEncoding.UTF8);

Result := Ts.text;

finally

FreeAndNil(Ts);

FreeAndNil(Response);

FreeAndNil(mHttp);

end;

function TForm1.GetName(val: string): String;

var

json, item, snippet: TJSONObject;

items: TJSONArray;

begin

try

json := TJSONObject.ParseJSONValue(TEncoding.UTF8.GetBytes(GetInfo(val)), 0) as TJSONObject;

items := TJSONObject.ParseJSONValue(TEncoding.UTF8.GetBytes(json.GetValue('items').ToString), 0) as TJSONArray;

item := items.Get(0) as TJSONObject;

snippet := item.GetValue('snippet') as TJSONObject;

Result := StringReplace(snippet.GetValue('title').ToString, '"', EmptyStr, [rfReplaceAll]);

except

on E: Exception do

Result := '';

end;

procedure TForm1.Logged(text: string);

begin

TThread.Queue(nil,

procedure

begin

Memo1.Lines.Add(text);

end);

end;

procedure TForm1.Panel1Click(Sender: TObject);

begin

ShellExecute(Handle, 'open', 'blog.yakupulutas.com/muzik-indirme-uygulamasi', nil, nil, SW_SHOW);

end;

procedure TForm1.YoutubeUrlClick(Sender: TObject);

var

i1: Integer;

begin

YoutubeUrl.text := Clipboard.AsText;

if Length(YoutubeUrl.text) < 8 then

Exit;

if Pos('youtube', YoutubeUrl.text) > 1 then

begin

i1 := Pos('watch?v=', YoutubeUrl.text) + 8;

wkod := Copy(YoutubeUrl.text, i1, 11);

end

else

begin

i1 := Pos('youtu.be', YoutubeUrl.text) + 9;

wkod := Copy(YoutubeUrl.text, i1, 11);

end;

Logged('watch : ' + wkod);

Caption := GetName(wkod);

Logged('Video Name : ' + Caption);

end;

end.

TYoutubeMp3Api içeriğini burada paylaşamıyorum, isteyen aşağıda yorumlarda belirtirse apiyi iletirim.

Devamını Oku

Fotoğraf Düzenleyici

25 Kasım 201716 Mart 2019 yhackup0

Merhabalar, Telefonumda çektiğim her anım değerlidir benim için sık sık bilgisayarıma HDD ve DVD’ye yedeklerim. Fakat telefona format atıyoruz veya başka nedenlerdn , telefonun fotoğraf sayacı sıfırdan başlıyor DCIM_0001.JPG gibi bu fotoğrafların isimleri aynı olduğu için aynı klasöye yedeklenemiyor birbirini değiştiriyor veya _1 ekleyerek kaydediyor fotoğraf tarih sıralaması vs hepten karışıyor. Aşağıdaki yaptığım uygulama ile, […]

Devamını Oku

.Net Ortamında geliştirilen dll içerisindeki fonksiyonu Delphi ile kullanmak.

27 Eylül 201716 Mart 2019 yhackup0

Bazen bir projede bir iş yapmanız gerekir ancak kullandığınız yazılım dilinde bu işi yapmak biraz meşakatli iken farklı bir yazılım dilinde bu iş diğerine göre daha kolay olabilir. Böyle durumlarda bazen paylaşılabilir/kullanılabilir dll yazmak çok daha mantıklı olur . Örnek vermek gerekirse Güçlü bir şifreleme algoritması olan ( Gerçi Adamın birisi kırabilmiş bu şifreleme metodunu […]

Devamını Oku

Toplu Olarak Dosya Uzantıları Değiştirme

6 Ağustos 201716 Mart 2019 yhackup0

Merhabalar. Bir klasör içerisindeki dosyaların uzantılarını değiştirmek için, Ren komutunu kullanabiliriz. Ren yazdıktan sonra boşluk bırakıp şu andaki dosya formatını, tekrar boşluk bırakıp olması gereken uzantıyı aşağıdaki gibi yazıp bat dosyası olarak kaydediniz. ve çalıştırınız. (Yönetici olarak çalıştırmayın.!)

Ren *.image *.jpeg
pause

1

2

3

4

5

6

Ren *.image *.jpeg

pause

Veya cmd konsolundan ilgili dosyaların dizinine ilerleyerekte bu komutu kullanabilirsiniz.

Devamını Oku

Uzak Masaüstü Bağlantısı – Remote Desktop Connection Uygulaması

28 Haziran 201716 Nisan 2019 yhackup0

Merhabalar, Kendi işlerim için geliştirdiğim\kullandığım, Sunuculara uzaktan erişim (RDP) yapabilmemi sağlayan bir uygulamadır. Sınırsız sayıda Uzak Masaüstü Bağlantısı yapılabilir. Kayıtları şifrelenmiş bir şekilde bulunduğu dizinde tutar. 10’larca temaya sahiptir. 15 Adete Kadar Ücretsizdir. V8 ile Güncelleme ekranı eklendi.. İndirmek için tıklayınız. 0.0.10.318 Zorla bağlan özelliği eklendi. (Bir başka kullanıcı, Sizin bağlantınızı […]

Devamını Oku

Delphi Soap Uygulamasında Client Ip’ini Yakalamak

20 Mayıs 201716 Mart 2019 yhackup0

function Getip: string;
var
mWebModule : TWebModule;
Dispatcher : IWebDispatcherAccess;
begin
Result := 'Tespit Edilemedi';
mWebModule := GetSOAPWebModule;
if mWebModule <> nil then
begin
if Supports(mWebModule, IWebDispatcherAccess, Dispatcher) then
Exit(Trim(Dispatcher.Request.RemoteAddr)); 
end;
end;

1

2

3

4

5

6

7

8

9

10

11

12

13

14

15

16

17

function Getip: string;

var

mWebModule : TWebModule;

Dispatcher : IWebDispatcherAccess;

begin

Result := 'Tespit Edilemedi';

mWebModule := GetSOAPWebModule;

if mWebModule <> nil then

begin

if Supports(mWebModule, IWebDispatcherAccess, Dispatcher) then

Exit(Trim(Dispatcher.Request.RemoteAddr));

end;

Devamını Oku

Delphi ile DataSet To XML

20 Mayıs 201716 Mart 2019 yhackup0

Var
XML : IXMLDOCUMENT;
PolisoftXMLExport,TabloName,Field:IXMLNODE;
i,a:integer;
begin
if  Data.IsEmpty then
begin
ShowMessage('DataSet is not null');
Exit;
end;
XML := NewXMLDocument;
XML.Encoding  := 'utf-8';
XML.Options   := [doNodeAutoIndent];
PolisoftXMLExport      := XML.AddChild('PolisoftXMLExport');
for I := 1 to Data.RecordCount do
begin
TabloName := PolisoftXMLExport.AddChild('Police',i);
Data.First;
for a := 1 to Data.FieldCount do
begin
Field := TabloName.AddChild(Data.Fields[a-1].FieldName,0);
Field.Text := Data.Fields[a-1].AsString;
end;
end;
XMl.SaveToFile(Path);
ShellExecute(HANDLE_FLAG_INHERIT,'open',PAnsiChar(Path),nil,nil,SW_HIDE); 
end

1

2

3

4

5

6

7

8

9

10

11

12

13

14

15

16

17

18

19

20

21

22

23

24

25

26

27

28

29

30

31

32

Var

XML : IXMLDOCUMENT;

PolisoftXMLExport,TabloName,Field:IXMLNODE;

i,a:integer;

begin

if Data.IsEmpty then

begin

ShowMessage('DataSet is not null');

Exit;

end;

XML := NewXMLDocument;

XML.Encoding := 'utf-8';

XML.Options := [doNodeAutoIndent];

PolisoftXMLExport := XML.AddChild('PolisoftXMLExport');

for I := 1 to Data.RecordCount do

begin

TabloName := PolisoftXMLExport.AddChild('Police',i);

Data.First;

for a := 1 to Data.FieldCount do

begin

Field := TabloName.AddChild(Data.Fields[a-1].FieldName,0);

Field.Text := Data.Fields[a-1].AsString;

end;

XMl.SaveToFile(Path);

ShellExecute(HANDLE_FLAG_INHERIT,'open',PAnsiChar(Path),nil,nil,SW_HIDE);

end

Devamını Oku

Delphi ile Gmail Hesabından Mail Gönderimi

30 Aralık 201616 Mart 2019 yhackup0

Benim en çok kullandığım şeydir kendileri. Yaptığınız exe dizininde libeay32.dll ve ssleay32.dll dosyaları bulunması gerekiyor aksi takdirde ssl hatası alırsınız. dll dosyalarını Buradan İndirebilirsiniz. gmaildll İlk mail gönderiminde başarısız olacaktır ve gmail size bir mail gönderecektir “Şifrenizi başka biri biliyor” gibi, o maili açarak o kişinin siz olduğunuzu işaretlemeniz gerekiyor ve ilgili ekran sizi bir kaç ayar […]

Devamını Oku