استخدم Delphi لتحقيق تنزيل سريع للصور على موقع الويب بأكمله

لقد رأيت اليوم منشورًا على S8S8. برنامج SHELL ، لغة C ، C ++ ، VBS ، PHP ، Perl ، Java و C#، إنه نزوة. ولكن بعد قراءة بعض الصور ، لم تكن جميعها مناسبة للأطفال.

رمز البرنامج الكامل:

// الكتابة صعبة نسبيًا ، لكنها يمكن أن تدرك بشكل أساسي وظيفة التنزيل ، لذلك لا يمكنني التحكم في ذلك كثيرًا.

وحدة getmm ؛

واجهة

يستخدم

Windows ، الرسائل ، sysutils ، المتغيرات ، الفئات ، الرسومات ، عناصر التحكم ، النماذج ،

مربعات الحوار ، stdctrls ، idbaseComponent ، idcomponent ، idtcpconnection ،

idtcpclient ، idhttp ؛

كونست

url = 'http: //www.sergeaura.net/tgp/' ؛

Offi = 192 ؛

Offj = 16 ؛

girlpic = 'c:/girlpic/' ؛

// فئة الموضوع

يكتب

tgetmm = فئة (tthread)

محمية

fmmurl: سلسلة.

fdestpath: سلسلة ؛

FSUBJ: سلسلة ؛

إجراء التنفيذ ؛ تجاوز ؛

عام

إنشاء مُنشئ (mmurl ، destpath ، subj: string) ؛

نهاية؛

يكتب

tform1 = فئة (tform)

Button1: Tbutton ؛

Button2: Tbutton ؛

MEMO1: TMEMO ؛

idhttp1: tidhttp ؛

مربع الاختيار 1: Tcheckbox ؛

الإجراءات button1click (المرسل: tobject) ؛

الإجراءات button2click (المرسل: tobject) ؛

خاص

{إعلانات خاصة}

RGETMM: tthread ؛

الإجراء getMmThread (mmurl ، destpath ، subj: string) ؛

عام

{الإعلانات العامة}

نهاية؛

var

Form1: Tform1 ؛

تطبيق

{$ r *.dfm}

// عملية التنزيل

الإجراء tform1.button1click (المرسل: tobject) ؛

var

أنا ، ي: عدد صحيح ؛

subi ، subj ، cururl ، destpath: string ؛

Strm: tmemorystream ؛

يبدأ

memo1.lines.clear ؛

// إنشاء دليل

إذا لم يكن الدليل (Girlpic) ثم

mkdir (girlpic) ؛

يحاول

strm: = tmemorystream.create ؛

لأني: = 1 إلى Offi تفعل

يبدأ

ل j: = 1 إلى Offj تفعل

يبدأ

إذا (أنا <10) ثم

subi: = '00'+inttostr (i)

آخر إذا (i> 9) و (i <100) ثم

subi: = '0'+inttostr (i)

آخر subi: = inttoStr (i) ؛

إذا (j> 9) ثم

subj: = inttostr (j)

else subj: = '0'+inttoStr (j) ؛

cururl: = url+subi+'/images/' ؛

DestPath: = girlpic+subi+'/' ؛

إذا لم يكن الدليل (DestPath) ثم

القسري (DESPATH) ؛

// استخدم المواضيع ، يمكن زيادة السرعة بأكثر من n times

إذا تم تحديد مربعات الاختيار 1.chected ثم

يبدأ

getMmThread (cururl ، destpath ، subj) ؛

النوم (500) ؛

إنهاء آخر

// لا يتم استخدام خيوط

يبدأ

يحاول

Strm.Clear ؛

idhttp1.get (cururl+subj+'. jpg' ، strm) ؛

strm.savetofile (destpath+subj+'. jpg') ؛

memo1.lines.add (cururl+'download ok!') ؛

Strm.Clear ؛

idhttp1.get (cururl+'tn _'+subj+'. jpg' ، strm) ؛

strm.savetofile (destpath+'tn _'+subj+'. jpg') ؛

memo1.lines.add (cururl+'download ok!') ؛

يستثني

memo1.lines.add (cururl+'download error!') ؛

نهاية؛

نهاية؛

نهاية؛

نهاية؛

memo1.lines.add ('all ok!') ؛

أخيراً

strm.free ؛

نهاية؛

نهاية؛

الإجراء tform1.button2Click (المرسل: tobject) ؛

يبدأ

يغلق؛

نهاية؛

{tgetmm}

مُنشئ tgetmm.create (mmurl ، destpath ، subj: string) ؛

يبدأ

fmmurl: = mmurl ؛

fdestpath: = destpath ؛

fsubj: = subj ؛

خلق ورث (خطأ) ؛

نهاية؛

الإجراء tgetmm.execute ؛

var

Strm: tmemorystream ؛

idgetmm: tidhttp ؛

DestFile: سلسلة.

يبدأ

يحاول

strm: = tmemorystream.create ؛

idgetmm: = tidhttp.create (nil) ؛

يحاول

DestFile: = fdestpath+fsubj+'. jpg' ؛

إذا لم يكن ملفات fileexists (destfile) ثم

يبدأ

Strm.Clear ؛

IDGETMM.GET (FMMURL+FSUBJ+'. JPG' ، strm) ؛

strm.savetofile (destfile) ؛

نهاية؛

DestFile: = fdestpath+'tn _'+fsubj+'. jpg' ؛

إذا لم يكن ملفات fileexists (destfile) ثم

يبدأ

Strm.Clear ؛

IdgetMm.get (fmmurl+'tn _'+fsubj+'. jpg' ، strm) ؛

strm.savetofile (destfile) ؛

نهاية؛

يستثني

نهاية؛

أخيراً

strm.free ؛

IDGETMM.Free ؛

نهاية؛

نهاية؛

الإجراء tform1.getmmthread (mmurl ، destpath ، subj: string) ؛

يبدأ

RGETMM: = tgetmm.create (Mmurl ، DestPath ، subj) ؛

نهاية؛

نهاية.