| 123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103210421052106210721082109211021112112211321142115211621172118211921202121212221232124212521262127212821292130213121322133213421352136213721382139214021412142214321442145214621472148214921502151215221532154215521562157215821592160216121622163216421652166216721682169217021712172217321742175217621772178217921802181218221832184218521862187218821892190219121922193219421952196219721982199220022012202220322042205220622072208220922102211221222132214221522162217221822192220222122222223222422252226222722282229223022312232223322342235223622372238223922402241224222432244224522462247224822492250225122522253225422552256225722582259226022612262226322642265226622672268226922702271227222732274227522762277227822792280228122822283228422852286228722882289229022912292229322942295229622972298229923002301230223032304230523062307230823092310231123122313231423152316231723182319232023212322232323242325232623272328232923302331233223332334233523362337233823392340234123422343234423452346234723482349235023512352235323542355235623572358235923602361236223632364236523662367236823692370237123722373237423752376237723782379238023812382238323842385238623872388238923902391239223932394239523962397239823992400240124022403240424052406240724082409241024112412241324142415241624172418241924202421242224232424242524262427242824292430243124322433243424352436243724382439244024412442244324442445244624472448244924502451245224532454245524562457245824592460246124622463246424652466246724682469247024712472247324742475247624772478247924802481248224832484248524862487248824892490249124922493249424952496249724982499250025012502250325042505250625072508250925102511251225132514251525162517251825192520252125222523252425252526252725282529253025312532253325342535253625372538253925402541254225432544254525462547254825492550255125522553255425552556255725582559256025612562256325642565256625672568256925702571257225732574257525762577257825792580258125822583258425852586258725882589259025912592259325942595259625972598259926002601260226032604260526062607260826092610261126122613261426152616261726182619262026212622262326242625262626272628262926302631263226332634263526362637263826392640264126422643264426452646264726482649265026512652265326542655265626572658265926602661266226632664266526662667266826692670267126722673267426752676267726782679268026812682268326842685268626872688268926902691269226932694269526962697269826992700270127022703270427052706270727082709271027112712271327142715271627172718271927202721272227232724272527262727272827292730273127322733273427352736273727382739274027412742274327442745274627472748274927502751275227532754275527562757275827592760276127622763276427652766276727682769277027712772277327742775277627772778277927802781278227832784278527862787278827892790279127922793279427952796279727982799280028012802280328042805280628072808280928102811281228132814281528162817281828192820282128222823282428252826282728282829283028312832283328342835283628372838283928402841284228432844284528462847284828492850285128522853285428552856285728582859286028612862286328642865286628672868286928702871287228732874287528762877287828792880288128822883288428852886288728882889289028912892289328942895289628972898289929002901290229032904290529062907290829092910291129122913291429152916291729182919292029212922292329242925292629272928292929302931293229332934293529362937293829392940294129422943294429452946294729482949295029512952295329542955295629572958295929602961296229632964296529662967296829692970297129722973297429752976297729782979298029812982298329842985298629872988298929902991299229932994299529962997299829993000300130023003300430053006300730083009301030113012301330143015301630173018301930203021302230233024302530263027302830293030303130323033303430353036303730383039304030413042304330443045304630473048304930503051305230533054305530563057305830593060306130623063306430653066306730683069307030713072307330743075307630773078307930803081308230833084308530863087308830893090309130923093309430953096309730983099310031013102310331043105310631073108310931103111311231133114311531163117311831193120312131223123312431253126312731283129313031313132313331343135313631373138313931403141314231433144314531463147314831493150315131523153315431553156315731583159316031613162316331643165316631673168316931703171317231733174317531763177317831793180318131823183318431853186318731883189319031913192319331943195319631973198319932003201320232033204320532063207320832093210321132123213321432153216321732183219322032213222322332243225322632273228322932303231323232333234323532363237323832393240324132423243324432453246324732483249325032513252325332543255325632573258325932603261326232633264326532663267326832693270327132723273327432753276327732783279328032813282328332843285328632873288328932903291329232933294329532963297329832993300330133023303330433053306330733083309331033113312331333143315331633173318331933203321332233233324332533263327332833293330333133323333333433353336333733383339334033413342334333443345334633473348334933503351335233533354335533563357335833593360336133623363336433653366336733683369337033713372337333743375337633773378337933803381338233833384338533863387338833893390339133923393339433953396339733983399340034013402340334043405340634073408340934103411341234133414341534163417341834193420342134223423342434253426342734283429343034313432343334343435343634373438343934403441344234433444344534463447344834493450345134523453345434553456345734583459346034613462346334643465346634673468346934703471347234733474347534763477347834793480348134823483348434853486348734883489349034913492349334943495349634973498349935003501350235033504350535063507350835093510351135123513351435153516351735183519352035213522352335243525352635273528352935303531353235333534353535363537353835393540354135423543354435453546354735483549355035513552355335543555355635573558355935603561356235633564356535663567356835693570357135723573357435753576357735783579358035813582358335843585358635873588358935903591359235933594359535963597359835993600360136023603360436053606360736083609361036113612361336143615361636173618361936203621362236233624362536263627362836293630363136323633363436353636363736383639364036413642364336443645364636473648364936503651365236533654365536563657365836593660366136623663366436653666366736683669367036713672367336743675367636773678367936803681368236833684368536863687368836893690369136923693369436953696369736983699370037013702370337043705370637073708370937103711371237133714371537163717371837193720372137223723372437253726372737283729373037313732373337343735373637373738373937403741374237433744374537463747374837493750375137523753375437553756375737583759376037613762376337643765376637673768376937703771377237733774377537763777377837793780378137823783378437853786378737883789379037913792379337943795379637973798379938003801380238033804380538063807380838093810381138123813381438153816381738183819382038213822382338243825382638273828382938303831383238333834383538363837383838393840384138423843384438453846384738483849385038513852385338543855385638573858385938603861386238633864386538663867386838693870387138723873387438753876387738783879388038813882388338843885388638873888388938903891389238933894389538963897389838993900390139023903390439053906390739083909391039113912391339143915391639173918391939203921392239233924392539263927392839293930393139323933393439353936393739383939394039413942394339443945394639473948394939503951395239533954395539563957395839593960396139623963396439653966396739683969397039713972397339743975397639773978397939803981398239833984398539863987398839893990399139923993399439953996399739983999400040014002400340044005400640074008400940104011401240134014401540164017401840194020402140224023402440254026402740284029403040314032403340344035403640374038403940404041404240434044404540464047404840494050405140524053405440554056405740584059406040614062406340644065406640674068406940704071407240734074407540764077407840794080408140824083408440854086408740884089409040914092409340944095409640974098409941004101410241034104410541064107410841094110411141124113411441154116411741184119412041214122412341244125412641274128412941304131413241334134413541364137413841394140414141424143414441454146414741484149415041514152415341544155415641574158415941604161416241634164416541664167416841694170417141724173417441754176417741784179418041814182418341844185418641874188418941904191419241934194419541964197419841994200420142024203420442054206420742084209421042114212421342144215421642174218421942204221422242234224422542264227422842294230423142324233423442354236423742384239424042414242424342444245424642474248424942504251425242534254425542564257425842594260426142624263426442654266426742684269427042714272427342744275427642774278427942804281428242834284428542864287428842894290429142924293429442954296429742984299430043014302430343044305430643074308430943104311431243134314431543164317431843194320432143224323432443254326432743284329433043314332433343344335433643374338433943404341434243434344434543464347434843494350435143524353435443554356435743584359436043614362436343644365436643674368436943704371437243734374437543764377437843794380438143824383438443854386438743884389439043914392439343944395439643974398439944004401440244034404440544064407440844094410441144124413441444154416441744184419442044214422442344244425442644274428442944304431443244334434443544364437443844394440444144424443444444454446444744484449445044514452445344544455445644574458445944604461446244634464446544664467446844694470447144724473447444754476447744784479448044814482448344844485448644874488448944904491449244934494449544964497449844994500450145024503450445054506450745084509451045114512451345144515451645174518451945204521452245234524452545264527452845294530453145324533453445354536453745384539454045414542454345444545454645474548454945504551455245534554455545564557455845594560456145624563456445654566456745684569457045714572457345744575457645774578457945804581458245834584458545864587458845894590459145924593459445954596459745984599460046014602460346044605460646074608460946104611461246134614461546164617461846194620462146224623462446254626462746284629463046314632463346344635463646374638463946404641464246434644464546464647464846494650465146524653465446554656465746584659466046614662466346644665466646674668466946704671467246734674467546764677467846794680468146824683468446854686468746884689469046914692469346944695469646974698469947004701470247034704470547064707470847094710471147124713471447154716471747184719472047214722472347244725472647274728472947304731473247334734473547364737473847394740474147424743474447454746474747484749475047514752475347544755475647574758475947604761476247634764476547664767476847694770477147724773477447754776477747784779478047814782478347844785478647874788478947904791479247934794479547964797479847994800480148024803480448054806480748084809481048114812481348144815481648174818481948204821482248234824482548264827482848294830483148324833483448354836483748384839484048414842484348444845484648474848484948504851485248534854485548564857485848594860486148624863486448654866486748684869487048714872487348744875487648774878487948804881488248834884488548864887488848894890489148924893489448954896489748984899490049014902490349044905490649074908490949104911491249134914491549164917491849194920492149224923492449254926492749284929493049314932493349344935493649374938493949404941494249434944494549464947494849494950495149524953495449554956495749584959496049614962496349644965496649674968496949704971497249734974497549764977497849794980498149824983498449854986498749884989499049914992499349944995499649974998499950005001500250035004500550065007500850095010501150125013501450155016501750185019502050215022502350245025502650275028502950305031503250335034503550365037503850395040504150425043504450455046504750485049505050515052505350545055505650575058505950605061506250635064506550665067506850695070507150725073507450755076507750785079508050815082508350845085508650875088508950905091509250935094509550965097509850995100510151025103510451055106510751085109511051115112511351145115511651175118511951205121512251235124512551265127512851295130513151325133513451355136513751385139514051415142514351445145514651475148514951505151515251535154515551565157515851595160516151625163516451655166516751685169517051715172517351745175517651775178517951805181518251835184518551865187518851895190519151925193519451955196519751985199520052015202520352045205520652075208520952105211521252135214521552165217521852195220522152225223522452255226522752285229523052315232523352345235523652375238523952405241524252435244524552465247524852495250525152525253525452555256525752585259526052615262526352645265526652675268526952705271527252735274527552765277527852795280528152825283528452855286528752885289529052915292529352945295529652975298529953005301530253035304530553065307530853095310531153125313531453155316531753185319532053215322532353245325532653275328532953305331533253335334533553365337533853395340534153425343534453455346534753485349535053515352535353545355535653575358535953605361536253635364536553665367536853695370537153725373537453755376537753785379538053815382538353845385538653875388538953905391539253935394539553965397539853995400540154025403540454055406540754085409541054115412541354145415541654175418541954205421542254235424542554265427542854295430543154325433543454355436543754385439544054415442544354445445544654475448544954505451545254535454545554565457545854595460546154625463546454655466546754685469547054715472547354745475547654775478547954805481548254835484548554865487548854895490549154925493549454955496549754985499550055015502550355045505550655075508550955105511551255135514551555165517551855195520552155225523552455255526552755285529553055315532553355345535553655375538553955405541554255435544554555465547554855495550555155525553555455555556555755585559556055615562556355645565556655675568556955705571557255735574557555765577557855795580558155825583558455855586558755885589559055915592559355945595559655975598559956005601560256035604560556065607560856095610561156125613561456155616561756185619562056215622562356245625562656275628562956305631563256335634563556365637563856395640564156425643564456455646564756485649565056515652565356545655565656575658565956605661566256635664566556665667566856695670567156725673567456755676567756785679568056815682568356845685568656875688568956905691569256935694569556965697569856995700570157025703570457055706570757085709571057115712571357145715571657175718571957205721572257235724572557265727572857295730573157325733573457355736573757385739574057415742574357445745574657475748574957505751575257535754575557565757575857595760576157625763576457655766576757685769577057715772577357745775577657775778577957805781578257835784578557865787578857895790579157925793579457955796579757985799580058015802580358045805580658075808580958105811581258135814581558165817581858195820582158225823582458255826582758285829583058315832583358345835583658375838583958405841584258435844584558465847584858495850585158525853585458555856585758585859586058615862586358645865586658675868586958705871587258735874587558765877587858795880588158825883588458855886588758885889589058915892589358945895589658975898589959005901590259035904590559065907590859095910591159125913591459155916591759185919592059215922592359245925592659275928592959305931593259335934593559365937593859395940594159425943594459455946594759485949595059515952595359545955595659575958595959605961596259635964596559665967596859695970597159725973597459755976597759785979598059815982598359845985598659875988598959905991599259935994599559965997599859996000600160026003600460056006600760086009601060116012601360146015601660176018601960206021602260236024602560266027602860296030603160326033603460356036603760386039604060416042604360446045604660476048604960506051605260536054605560566057605860596060606160626063606460656066606760686069607060716072607360746075607660776078607960806081608260836084608560866087608860896090609160926093609460956096609760986099610061016102610361046105610661076108610961106111611261136114611561166117611861196120612161226123612461256126612761286129613061316132613361346135613661376138613961406141614261436144614561466147614861496150615161526153615461556156615761586159616061616162616361646165616661676168616961706171617261736174617561766177617861796180618161826183618461856186618761886189619061916192619361946195619661976198619962006201620262036204620562066207620862096210621162126213621462156216621762186219622062216222622362246225622662276228622962306231623262336234623562366237623862396240624162426243624462456246624762486249625062516252625362546255625662576258625962606261626262636264626562666267626862696270627162726273627462756276627762786279628062816282628362846285628662876288628962906291629262936294629562966297629862996300630163026303630463056306630763086309631063116312631363146315631663176318631963206321632263236324632563266327632863296330633163326333633463356336633763386339634063416342634363446345634663476348634963506351635263536354635563566357635863596360636163626363636463656366636763686369637063716372637363746375637663776378637963806381638263836384638563866387638863896390639163926393639463956396639763986399640064016402640364046405640664076408640964106411641264136414641564166417641864196420642164226423642464256426642764286429643064316432643364346435643664376438643964406441644264436444644564466447644864496450645164526453645464556456645764586459646064616462646364646465646664676468646964706471647264736474647564766477647864796480648164826483648464856486648764886489649064916492649364946495649664976498649965006501650265036504650565066507650865096510651165126513651465156516651765186519652065216522652365246525652665276528652965306531653265336534653565366537653865396540654165426543654465456546654765486549655065516552655365546555655665576558655965606561656265636564656565666567656865696570657165726573657465756576657765786579658065816582658365846585658665876588658965906591659265936594659565966597659865996600660166026603660466056606660766086609661066116612661366146615661666176618661966206621662266236624662566266627662866296630663166326633663466356636663766386639664066416642664366446645664666476648664966506651665266536654665566566657665866596660666166626663666466656666666766686669667066716672667366746675667666776678667966806681668266836684668566866687668866896690669166926693669466956696669766986699670067016702670367046705670667076708670967106711671267136714671567166717671867196720672167226723672467256726672767286729673067316732673367346735673667376738673967406741674267436744674567466747674867496750675167526753675467556756675767586759676067616762676367646765676667676768676967706771677267736774677567766777677867796780678167826783678467856786678767886789679067916792679367946795679667976798679968006801680268036804680568066807680868096810681168126813681468156816681768186819682068216822682368246825682668276828682968306831683268336834683568366837683868396840684168426843684468456846684768486849685068516852685368546855685668576858685968606861686268636864686568666867686868696870687168726873687468756876687768786879688068816882688368846885688668876888688968906891689268936894689568966897689868996900690169026903690469056906690769086909691069116912691369146915691669176918691969206921692269236924692569266927692869296930693169326933693469356936693769386939694069416942694369446945694669476948694969506951695269536954695569566957695869596960696169626963696469656966696769686969697069716972697369746975697669776978697969806981698269836984698569866987698869896990699169926993699469956996699769986999700070017002700370047005700670077008700970107011701270137014701570167017701870197020702170227023702470257026702770287029703070317032703370347035703670377038703970407041704270437044704570467047704870497050705170527053705470557056705770587059706070617062706370647065706670677068706970707071707270737074707570767077707870797080708170827083708470857086708770887089709070917092709370947095709670977098709971007101710271037104710571067107710871097110711171127113711471157116711771187119712071217122712371247125712671277128712971307131713271337134713571367137713871397140714171427143714471457146714771487149715071517152715371547155715671577158715971607161716271637164716571667167716871697170717171727173717471757176717771787179718071817182718371847185718671877188718971907191719271937194719571967197719871997200720172027203720472057206720772087209721072117212721372147215721672177218721972207221722272237224722572267227722872297230723172327233723472357236723772387239724072417242724372447245724672477248724972507251725272537254725572567257725872597260726172627263726472657266726772687269727072717272727372747275727672777278727972807281728272837284728572867287728872897290729172927293729472957296729772987299730073017302730373047305730673077308730973107311731273137314731573167317731873197320732173227323732473257326732773287329733073317332733373347335733673377338733973407341734273437344734573467347734873497350735173527353735473557356735773587359736073617362736373647365736673677368736973707371737273737374737573767377737873797380738173827383738473857386738773887389739073917392739373947395739673977398739974007401740274037404740574067407740874097410741174127413741474157416741774187419742074217422742374247425742674277428742974307431743274337434743574367437743874397440744174427443744474457446744774487449745074517452745374547455745674577458745974607461746274637464746574667467746874697470747174727473747474757476747774787479748074817482748374847485748674877488748974907491749274937494749574967497749874997500750175027503750475057506750775087509751075117512751375147515751675177518751975207521752275237524752575267527752875297530753175327533753475357536753775387539754075417542754375447545754675477548754975507551755275537554755575567557755875597560756175627563756475657566756775687569757075717572757375747575757675777578757975807581758275837584758575867587758875897590759175927593759475957596759775987599760076017602760376047605760676077608760976107611761276137614761576167617761876197620762176227623762476257626762776287629763076317632763376347635763676377638763976407641764276437644764576467647764876497650765176527653765476557656765776587659766076617662766376647665766676677668766976707671767276737674767576767677767876797680768176827683768476857686768776887689769076917692769376947695769676977698769977007701770277037704770577067707770877097710771177127713771477157716771777187719772077217722772377247725772677277728772977307731773277337734773577367737773877397740774177427743774477457746774777487749775077517752775377547755775677577758775977607761776277637764776577667767776877697770777177727773777477757776777777787779778077817782778377847785778677877788778977907791779277937794779577967797779877997800780178027803780478057806780778087809781078117812781378147815781678177818781978207821782278237824782578267827782878297830783178327833783478357836783778387839784078417842784378447845784678477848784978507851785278537854785578567857785878597860786178627863786478657866786778687869787078717872787378747875787678777878787978807881788278837884788578867887788878897890789178927893789478957896789778987899790079017902790379047905790679077908790979107911791279137914791579167917791879197920792179227923792479257926792779287929793079317932793379347935793679377938793979407941794279437944794579467947794879497950795179527953795479557956795779587959796079617962796379647965796679677968796979707971797279737974797579767977797879797980798179827983798479857986798779887989799079917992799379947995799679977998799980008001800280038004800580068007800880098010801180128013801480158016801780188019802080218022802380248025802680278028802980308031803280338034803580368037803880398040804180428043804480458046804780488049805080518052805380548055805680578058805980608061806280638064806580668067806880698070807180728073807480758076807780788079808080818082808380848085808680878088808980908091809280938094809580968097809880998100810181028103810481058106810781088109811081118112811381148115811681178118811981208121812281238124812581268127812881298130813181328133813481358136813781388139814081418142814381448145814681478148814981508151815281538154815581568157815881598160816181628163816481658166816781688169817081718172817381748175817681778178817981808181818281838184818581868187818881898190819181928193819481958196819781988199820082018202820382048205820682078208820982108211821282138214821582168217821882198220822182228223822482258226822782288229823082318232823382348235823682378238823982408241824282438244824582468247824882498250825182528253825482558256825782588259826082618262826382648265826682678268826982708271827282738274827582768277827882798280828182828283828482858286828782888289829082918292829382948295829682978298829983008301830283038304830583068307830883098310831183128313831483158316831783188319832083218322832383248325832683278328832983308331833283338334833583368337833883398340834183428343834483458346834783488349835083518352835383548355835683578358835983608361836283638364836583668367836883698370837183728373837483758376837783788379838083818382838383848385838683878388838983908391839283938394839583968397839883998400840184028403840484058406840784088409841084118412841384148415841684178418841984208421842284238424842584268427842884298430843184328433843484358436843784388439844084418442844384448445844684478448844984508451845284538454845584568457845884598460846184628463846484658466846784688469847084718472847384748475847684778478847984808481848284838484848584868487848884898490849184928493849484958496849784988499850085018502850385048505850685078508850985108511851285138514851585168517851885198520852185228523852485258526852785288529853085318532853385348535853685378538853985408541854285438544854585468547854885498550855185528553855485558556855785588559856085618562856385648565856685678568856985708571857285738574857585768577857885798580858185828583858485858586858785888589859085918592859385948595859685978598859986008601860286038604860586068607860886098610861186128613861486158616861786188619862086218622862386248625862686278628862986308631863286338634863586368637863886398640864186428643864486458646864786488649865086518652865386548655865686578658865986608661866286638664866586668667866886698670867186728673867486758676867786788679868086818682868386848685868686878688868986908691869286938694869586968697869886998700870187028703870487058706870787088709871087118712871387148715871687178718871987208721872287238724872587268727872887298730873187328733873487358736873787388739874087418742874387448745874687478748874987508751875287538754875587568757875887598760876187628763876487658766876787688769877087718772877387748775877687778778877987808781878287838784878587868787878887898790879187928793879487958796879787988799880088018802880388048805880688078808880988108811881288138814881588168817881888198820882188228823882488258826882788288829883088318832883388348835883688378838883988408841884288438844884588468847884888498850885188528853885488558856885788588859886088618862886388648865886688678868886988708871887288738874887588768877887888798880888188828883888488858886888788888889889088918892889388948895889688978898889989008901890289038904890589068907890889098910891189128913891489158916891789188919892089218922892389248925892689278928892989308931893289338934893589368937893889398940894189428943894489458946894789488949895089518952895389548955895689578958895989608961896289638964896589668967896889698970897189728973897489758976897789788979898089818982898389848985898689878988898989908991899289938994899589968997899889999000900190029003900490059006900790089009901090119012901390149015901690179018901990209021902290239024902590269027902890299030903190329033903490359036903790389039904090419042904390449045904690479048904990509051905290539054905590569057905890599060906190629063906490659066906790689069907090719072907390749075907690779078907990809081908290839084908590869087908890899090909190929093909490959096909790989099910091019102910391049105910691079108910991109111911291139114911591169117911891199120912191229123912491259126912791289129913091319132913391349135913691379138913991409141914291439144914591469147914891499150915191529153915491559156915791589159916091619162916391649165916691679168916991709171917291739174917591769177917891799180918191829183918491859186918791889189919091919192919391949195919691979198919992009201920292039204920592069207920892099210921192129213921492159216921792189219922092219222922392249225922692279228922992309231923292339234923592369237923892399240924192429243924492459246924792489249925092519252925392549255925692579258925992609261926292639264926592669267926892699270927192729273927492759276927792789279928092819282928392849285928692879288928992909291929292939294929592969297929892999300930193029303930493059306930793089309931093119312931393149315931693179318931993209321932293239324932593269327932893299330933193329333933493359336933793389339934093419342934393449345934693479348934993509351935293539354935593569357935893599360936193629363936493659366936793689369937093719372937393749375937693779378937993809381938293839384938593869387938893899390939193929393939493959396939793989399940094019402940394049405940694079408940994109411941294139414941594169417941894199420942194229423942494259426942794289429943094319432943394349435943694379438943994409441944294439444944594469447944894499450945194529453945494559456945794589459946094619462946394649465946694679468946994709471947294739474947594769477947894799480948194829483948494859486948794889489949094919492949394949495949694979498949995009501950295039504950595069507950895099510951195129513951495159516951795189519952095219522952395249525952695279528952995309531953295339534953595369537953895399540954195429543954495459546954795489549955095519552955395549555955695579558955995609561956295639564956595669567956895699570957195729573957495759576957795789579958095819582958395849585958695879588958995909591959295939594959595969597959895999600960196029603960496059606960796089609961096119612961396149615961696179618961996209621962296239624962596269627962896299630963196329633963496359636963796389639964096419642964396449645964696479648964996509651965296539654965596569657965896599660966196629663966496659666966796689669967096719672967396749675967696779678967996809681968296839684968596869687968896899690969196929693969496959696969796989699970097019702970397049705970697079708970997109711971297139714971597169717971897199720972197229723972497259726972797289729973097319732973397349735973697379738973997409741974297439744974597469747974897499750975197529753975497559756975797589759976097619762976397649765976697679768976997709771977297739774977597769777977897799780978197829783978497859786978797889789979097919792979397949795979697979798979998009801980298039804980598069807980898099810981198129813981498159816981798189819982098219822982398249825982698279828982998309831983298339834983598369837983898399840984198429843984498459846984798489849985098519852985398549855985698579858985998609861986298639864986598669867986898699870987198729873987498759876987798789879988098819882988398849885988698879888988998909891989298939894989598969897989898999900990199029903990499059906990799089909991099119912991399149915991699179918991999209921992299239924992599269927992899299930993199329933993499359936993799389939994099419942994399449945994699479948994999509951995299539954995599569957995899599960996199629963996499659966996799689969997099719972997399749975997699779978997999809981998299839984998599869987998899899990999199929993999499959996999799989999100001000110002100031000410005100061000710008100091001010011100121001310014100151001610017100181001910020100211002210023100241002510026100271002810029100301003110032100331003410035100361003710038100391004010041100421004310044100451004610047100481004910050100511005210053100541005510056100571005810059100601006110062100631006410065100661006710068100691007010071100721007310074100751007610077100781007910080100811008210083100841008510086100871008810089100901009110092100931009410095100961009710098100991010010101101021010310104101051010610107101081010910110101111011210113101141011510116101171011810119101201012110122101231012410125101261012710128101291013010131101321013310134101351013610137101381013910140101411014210143101441014510146101471014810149101501015110152101531015410155101561015710158101591016010161101621016310164101651016610167101681016910170101711017210173101741017510176101771017810179101801018110182101831018410185101861018710188101891019010191101921019310194101951019610197101981019910200102011020210203102041020510206102071020810209102101021110212102131021410215102161021710218102191022010221102221022310224102251022610227102281022910230102311023210233102341023510236102371023810239102401024110242102431024410245102461024710248102491025010251102521025310254102551025610257102581025910260102611026210263102641026510266102671026810269102701027110272102731027410275102761027710278102791028010281102821028310284102851028610287102881028910290102911029210293102941029510296102971029810299103001030110302103031030410305103061030710308103091031010311103121031310314103151031610317103181031910320103211032210323103241032510326103271032810329103301033110332103331033410335103361033710338103391034010341103421034310344103451034610347103481034910350103511035210353103541035510356103571035810359103601036110362103631036410365103661036710368103691037010371103721037310374103751037610377103781037910380103811038210383103841038510386103871038810389103901039110392103931039410395103961039710398103991040010401104021040310404104051040610407104081040910410104111041210413104141041510416104171041810419104201042110422104231042410425104261042710428104291043010431104321043310434104351043610437104381043910440104411044210443104441044510446104471044810449104501045110452104531045410455104561045710458104591046010461104621046310464104651046610467104681046910470104711047210473104741047510476104771047810479104801048110482104831048410485104861048710488104891049010491104921049310494104951049610497104981049910500105011050210503105041050510506105071050810509105101051110512105131051410515105161051710518105191052010521105221052310524105251052610527105281052910530105311053210533105341053510536105371053810539105401054110542105431054410545105461054710548105491055010551105521055310554105551055610557105581055910560105611056210563105641056510566105671056810569105701057110572105731057410575105761057710578105791058010581105821058310584105851058610587105881058910590105911059210593105941059510596105971059810599106001060110602106031060410605106061060710608106091061010611106121061310614106151061610617106181061910620106211062210623106241062510626106271062810629106301063110632106331063410635106361063710638106391064010641106421064310644106451064610647106481064910650106511065210653106541065510656106571065810659106601066110662106631066410665106661066710668106691067010671106721067310674106751067610677106781067910680106811068210683106841068510686106871068810689106901069110692106931069410695106961069710698106991070010701107021070310704107051070610707107081070910710107111071210713107141071510716107171071810719107201072110722107231072410725107261072710728107291073010731107321073310734107351073610737107381073910740107411074210743107441074510746107471074810749107501075110752107531075410755107561075710758107591076010761107621076310764107651076610767107681076910770107711077210773107741077510776107771077810779107801078110782107831078410785107861078710788107891079010791107921079310794107951079610797107981079910800108011080210803108041080510806108071080810809108101081110812108131081410815108161081710818108191082010821108221082310824108251082610827108281082910830108311083210833108341083510836108371083810839108401084110842108431084410845108461084710848108491085010851108521085310854108551085610857108581085910860108611086210863108641086510866108671086810869108701087110872108731087410875108761087710878108791088010881108821088310884108851088610887108881088910890108911089210893108941089510896108971089810899109001090110902109031090410905109061090710908109091091010911109121091310914109151091610917109181091910920109211092210923109241092510926109271092810929109301093110932109331093410935109361093710938109391094010941109421094310944109451094610947109481094910950109511095210953109541095510956109571095810959109601096110962109631096410965109661096710968109691097010971109721097310974109751097610977109781097910980109811098210983109841098510986109871098810989109901099110992109931099410995109961099710998109991100011001110021100311004110051100611007110081100911010110111101211013110141101511016110171101811019110201102111022110231102411025110261102711028110291103011031110321103311034110351103611037110381103911040110411104211043110441104511046110471104811049110501105111052110531105411055110561105711058110591106011061110621106311064110651106611067110681106911070110711107211073110741107511076110771107811079110801108111082110831108411085110861108711088110891109011091110921109311094110951109611097110981109911100111011110211103111041110511106111071110811109111101111111112111131111411115111161111711118111191112011121111221112311124111251112611127111281112911130111311113211133111341113511136111371113811139111401114111142111431114411145111461114711148111491115011151111521115311154111551115611157111581115911160111611116211163111641116511166111671116811169111701117111172111731117411175111761117711178111791118011181111821118311184111851118611187111881118911190111911119211193111941119511196111971119811199112001120111202112031120411205112061120711208112091121011211112121121311214112151121611217112181121911220112211122211223112241122511226112271122811229112301123111232112331123411235112361123711238112391124011241112421124311244112451124611247112481124911250112511125211253112541125511256112571125811259112601126111262112631126411265112661126711268112691127011271112721127311274112751127611277112781127911280112811128211283112841128511286112871128811289112901129111292112931129411295112961129711298112991130011301113021130311304113051130611307113081130911310113111131211313113141131511316113171131811319113201132111322113231132411325113261132711328113291133011331113321133311334113351133611337113381133911340113411134211343113441134511346113471134811349113501135111352113531135411355113561135711358113591136011361113621136311364113651136611367113681136911370113711137211373113741137511376113771137811379113801138111382113831138411385113861138711388113891139011391113921139311394113951139611397113981139911400114011140211403114041140511406114071140811409114101141111412114131141411415114161141711418114191142011421114221142311424114251142611427114281142911430114311143211433114341143511436114371143811439114401144111442114431144411445114461144711448114491145011451114521145311454114551145611457114581145911460114611146211463114641146511466114671146811469114701147111472114731147411475114761147711478114791148011481114821148311484114851148611487114881148911490114911149211493114941149511496114971149811499115001150111502115031150411505115061150711508115091151011511115121151311514115151151611517115181151911520115211152211523115241152511526115271152811529115301153111532115331153411535115361153711538115391154011541115421154311544115451154611547115481154911550115511155211553115541155511556115571155811559115601156111562115631156411565115661156711568115691157011571115721157311574115751157611577115781157911580115811158211583115841158511586115871158811589115901159111592115931159411595115961159711598115991160011601116021160311604116051160611607116081160911610116111161211613116141161511616116171161811619116201162111622116231162411625116261162711628116291163011631116321163311634116351163611637116381163911640116411164211643116441164511646116471164811649116501165111652116531165411655116561165711658116591166011661116621166311664116651166611667116681166911670116711167211673116741167511676116771167811679116801168111682116831168411685116861168711688116891169011691116921169311694116951169611697116981169911700117011170211703117041170511706117071170811709117101171111712117131171411715117161171711718117191172011721117221172311724117251172611727117281172911730117311173211733117341173511736117371173811739117401174111742117431174411745117461174711748117491175011751117521175311754117551175611757117581175911760117611176211763117641176511766117671176811769117701177111772117731177411775117761177711778117791178011781117821178311784117851178611787117881178911790117911179211793117941179511796117971179811799118001180111802118031180411805118061180711808118091181011811118121181311814118151181611817118181181911820118211182211823118241182511826118271182811829118301183111832118331183411835118361183711838118391184011841118421184311844118451184611847118481184911850118511185211853118541185511856118571185811859118601186111862118631186411865118661186711868118691187011871118721187311874118751187611877118781187911880118811188211883118841188511886118871188811889118901189111892118931189411895118961189711898118991190011901119021190311904119051190611907119081190911910119111191211913119141191511916119171191811919119201192111922119231192411925119261192711928119291193011931119321193311934119351193611937119381193911940119411194211943119441194511946119471194811949119501195111952119531195411955119561195711958119591196011961119621196311964119651196611967119681196911970119711197211973119741197511976119771197811979119801198111982119831198411985119861198711988119891199011991119921199311994119951199611997119981199912000120011200212003120041200512006120071200812009120101201112012120131201412015120161201712018120191202012021120221202312024120251202612027120281202912030120311203212033120341203512036120371203812039120401204112042120431204412045120461204712048120491205012051120521205312054120551205612057120581205912060120611206212063120641206512066120671206812069120701207112072120731207412075120761207712078120791208012081120821208312084120851208612087120881208912090120911209212093120941209512096120971209812099121001210112102121031210412105121061210712108121091211012111121121211312114121151211612117121181211912120121211212212123121241212512126121271212812129121301213112132121331213412135121361213712138121391214012141121421214312144121451214612147121481214912150121511215212153121541215512156121571215812159121601216112162121631216412165121661216712168121691217012171121721217312174121751217612177121781217912180121811218212183121841218512186121871218812189121901219112192121931219412195121961219712198121991220012201122021220312204122051220612207122081220912210122111221212213122141221512216122171221812219122201222112222122231222412225122261222712228122291223012231122321223312234122351223612237122381223912240122411224212243122441224512246122471224812249122501225112252122531225412255122561225712258122591226012261122621226312264122651226612267122681226912270122711227212273122741227512276122771227812279122801228112282122831228412285122861228712288122891229012291122921229312294122951229612297122981229912300123011230212303123041230512306123071230812309123101231112312123131231412315123161231712318123191232012321123221232312324123251232612327123281232912330123311233212333123341233512336123371233812339123401234112342123431234412345123461234712348123491235012351123521235312354123551235612357123581235912360123611236212363123641236512366123671236812369123701237112372123731237412375123761237712378123791238012381123821238312384123851238612387123881238912390123911239212393123941239512396123971239812399124001240112402124031240412405124061240712408124091241012411124121241312414124151241612417124181241912420124211242212423124241242512426124271242812429124301243112432124331243412435124361243712438124391244012441124421244312444124451244612447124481244912450124511245212453124541245512456124571245812459124601246112462124631246412465124661246712468124691247012471124721247312474124751247612477124781247912480124811248212483124841248512486124871248812489124901249112492124931249412495124961249712498124991250012501125021250312504125051250612507125081250912510125111251212513125141251512516125171251812519125201252112522125231252412525125261252712528125291253012531125321253312534125351253612537125381253912540125411254212543125441254512546125471254812549125501255112552125531255412555125561255712558125591256012561125621256312564125651256612567125681256912570125711257212573125741257512576125771257812579125801258112582125831258412585125861258712588125891259012591125921259312594125951259612597125981259912600126011260212603126041260512606126071260812609126101261112612126131261412615126161261712618126191262012621126221262312624126251262612627126281262912630126311263212633126341263512636126371263812639126401264112642126431264412645126461264712648126491265012651126521265312654126551265612657126581265912660126611266212663126641266512666126671266812669126701267112672126731267412675126761267712678126791268012681126821268312684126851268612687126881268912690126911269212693126941269512696126971269812699127001270112702127031270412705127061270712708127091271012711127121271312714127151271612717127181271912720127211272212723127241272512726127271272812729127301273112732127331273412735127361273712738127391274012741127421274312744127451274612747127481274912750127511275212753127541275512756127571275812759127601276112762127631276412765127661276712768127691277012771127721277312774127751277612777127781277912780127811278212783127841278512786127871278812789127901279112792127931279412795127961279712798127991280012801128021280312804128051280612807128081280912810128111281212813128141281512816128171281812819128201282112822128231282412825128261282712828128291283012831128321283312834128351283612837128381283912840128411284212843128441284512846128471284812849128501285112852128531285412855128561285712858128591286012861128621286312864128651286612867128681286912870128711287212873128741287512876128771287812879128801288112882128831288412885128861288712888128891289012891128921289312894128951289612897128981289912900129011290212903129041290512906129071290812909129101291112912129131291412915129161291712918129191292012921129221292312924129251292612927129281292912930129311293212933129341293512936129371293812939129401294112942129431294412945129461294712948129491295012951129521295312954129551295612957129581295912960129611296212963129641296512966129671296812969129701297112972129731297412975129761297712978129791298012981129821298312984129851298612987129881298912990129911299212993129941299512996129971299812999130001300113002130031300413005130061300713008130091301013011130121301313014130151301613017130181301913020130211302213023130241302513026130271302813029130301303113032130331303413035130361303713038130391304013041130421304313044130451304613047130481304913050130511305213053130541305513056130571305813059130601306113062130631306413065130661306713068130691307013071130721307313074130751307613077130781307913080130811308213083130841308513086130871308813089130901309113092130931309413095130961309713098130991310013101131021310313104131051310613107131081310913110131111311213113131141311513116131171311813119131201312113122131231312413125131261312713128131291313013131131321313313134131351313613137131381313913140131411314213143131441314513146131471314813149131501315113152131531315413155131561315713158131591316013161131621316313164131651316613167131681316913170131711317213173131741317513176131771317813179131801318113182131831318413185131861318713188131891319013191131921319313194131951319613197131981319913200132011320213203132041320513206132071320813209132101321113212132131321413215132161321713218132191322013221132221322313224132251322613227132281322913230132311323213233132341323513236132371323813239132401324113242132431324413245132461324713248132491325013251132521325313254132551325613257132581325913260132611326213263132641326513266132671326813269132701327113272132731327413275132761327713278132791328013281132821328313284132851328613287132881328913290132911329213293132941329513296132971329813299133001330113302133031330413305133061330713308133091331013311133121331313314133151331613317133181331913320133211332213323133241332513326133271332813329133301333113332133331333413335133361333713338133391334013341133421334313344133451334613347133481334913350133511335213353133541335513356133571335813359133601336113362133631336413365133661336713368133691337013371133721337313374133751337613377133781337913380133811338213383133841338513386133871338813389133901339113392133931339413395133961339713398133991340013401134021340313404134051340613407134081340913410134111341213413134141341513416134171341813419134201342113422134231342413425134261342713428134291343013431134321343313434134351343613437134381343913440134411344213443134441344513446134471344813449134501345113452134531345413455134561345713458134591346013461134621346313464134651346613467134681346913470134711347213473134741347513476134771347813479134801348113482134831348413485134861348713488134891349013491134921349313494134951349613497134981349913500135011350213503135041350513506135071350813509135101351113512135131351413515135161351713518135191352013521135221352313524135251352613527135281352913530135311353213533135341353513536135371353813539135401354113542135431354413545135461354713548135491355013551135521355313554135551355613557135581355913560135611356213563135641356513566135671356813569135701357113572135731357413575135761357713578135791358013581135821358313584135851358613587135881358913590135911359213593135941359513596135971359813599136001360113602136031360413605136061360713608136091361013611136121361313614136151361613617136181361913620136211362213623136241362513626136271362813629136301363113632136331363413635136361363713638136391364013641136421364313644136451364613647136481364913650136511365213653136541365513656136571365813659136601366113662136631366413665136661366713668136691367013671136721367313674136751367613677136781367913680136811368213683136841368513686136871368813689136901369113692136931369413695136961369713698136991370013701137021370313704137051370613707137081370913710137111371213713137141371513716137171371813719137201372113722137231372413725137261372713728137291373013731137321373313734137351373613737137381373913740137411374213743137441374513746137471374813749137501375113752137531375413755137561375713758137591376013761137621376313764137651376613767137681376913770137711377213773137741377513776137771377813779137801378113782137831378413785137861378713788137891379013791137921379313794137951379613797137981379913800138011380213803138041380513806138071380813809138101381113812138131381413815138161381713818138191382013821138221382313824138251382613827138281382913830138311383213833138341383513836138371383813839138401384113842138431384413845138461384713848138491385013851138521385313854138551385613857138581385913860138611386213863138641386513866138671386813869138701387113872138731387413875138761387713878138791388013881138821388313884138851388613887138881388913890138911389213893138941389513896138971389813899139001390113902139031390413905139061390713908139091391013911139121391313914139151391613917139181391913920139211392213923139241392513926139271392813929139301393113932139331393413935139361393713938139391394013941139421394313944139451394613947139481394913950139511395213953139541395513956139571395813959139601396113962139631396413965139661396713968139691397013971139721397313974139751397613977139781397913980139811398213983139841398513986139871398813989139901399113992139931399413995139961399713998139991400014001140021400314004140051400614007140081400914010140111401214013140141401514016140171401814019140201402114022140231402414025140261402714028140291403014031140321403314034140351403614037140381403914040140411404214043140441404514046140471404814049140501405114052140531405414055140561405714058140591406014061140621406314064140651406614067140681406914070140711407214073140741407514076140771407814079140801408114082140831408414085140861408714088140891409014091140921409314094140951409614097140981409914100141011410214103141041410514106141071410814109141101411114112141131411414115141161411714118141191412014121141221412314124141251412614127141281412914130141311413214133141341413514136141371413814139141401414114142141431414414145141461414714148141491415014151141521415314154141551415614157141581415914160141611416214163141641416514166141671416814169141701417114172141731417414175141761417714178141791418014181141821418314184141851418614187141881418914190141911419214193141941419514196141971419814199142001420114202142031420414205142061420714208142091421014211142121421314214142151421614217142181421914220142211422214223142241422514226142271422814229142301423114232142331423414235142361423714238142391424014241142421424314244142451424614247142481424914250142511425214253142541425514256142571425814259142601426114262142631426414265142661426714268142691427014271142721427314274142751427614277142781427914280142811428214283142841428514286142871428814289142901429114292142931429414295142961429714298142991430014301143021430314304143051430614307143081430914310143111431214313143141431514316143171431814319143201432114322143231432414325143261432714328143291433014331143321433314334143351433614337143381433914340143411434214343143441434514346143471434814349143501435114352143531435414355143561435714358143591436014361143621436314364143651436614367143681436914370143711437214373143741437514376143771437814379143801438114382143831438414385143861438714388143891439014391143921439314394143951439614397143981439914400144011440214403144041440514406144071440814409144101441114412144131441414415144161441714418144191442014421144221442314424144251442614427144281442914430144311443214433144341443514436144371443814439144401444114442144431444414445144461444714448144491445014451144521445314454144551445614457144581445914460144611446214463144641446514466144671446814469144701447114472144731447414475144761447714478144791448014481144821448314484144851448614487144881448914490144911449214493144941449514496144971449814499145001450114502145031450414505145061450714508145091451014511145121451314514145151451614517145181451914520145211452214523145241452514526145271452814529145301453114532145331453414535145361453714538145391454014541145421454314544145451454614547145481454914550145511455214553145541455514556145571455814559145601456114562145631456414565145661456714568145691457014571145721457314574145751457614577145781457914580145811458214583145841458514586145871458814589145901459114592145931459414595145961459714598145991460014601146021460314604146051460614607146081460914610146111461214613146141461514616146171461814619146201462114622146231462414625146261462714628146291463014631146321463314634146351463614637146381463914640146411464214643146441464514646146471464814649146501465114652146531465414655146561465714658146591466014661146621466314664146651466614667146681466914670146711467214673146741467514676146771467814679146801468114682146831468414685146861468714688146891469014691146921469314694146951469614697146981469914700147011470214703147041470514706147071470814709147101471114712147131471414715147161471714718147191472014721147221472314724147251472614727147281472914730147311473214733147341473514736147371473814739147401474114742147431474414745147461474714748147491475014751147521475314754147551475614757147581475914760147611476214763147641476514766147671476814769147701477114772147731477414775147761477714778147791478014781147821478314784147851478614787147881478914790147911479214793147941479514796147971479814799148001480114802148031480414805148061480714808148091481014811148121481314814148151481614817148181481914820148211482214823148241482514826148271482814829148301483114832148331483414835148361483714838148391484014841148421484314844148451484614847148481484914850148511485214853148541485514856148571485814859148601486114862148631486414865148661486714868148691487014871148721487314874148751487614877148781487914880148811488214883148841488514886148871488814889148901489114892148931489414895148961489714898148991490014901149021490314904149051490614907149081490914910149111491214913149141491514916149171491814919149201492114922149231492414925149261492714928149291493014931149321493314934149351493614937149381493914940149411494214943149441494514946149471494814949149501495114952149531495414955149561495714958149591496014961149621496314964149651496614967149681496914970149711497214973149741497514976149771497814979149801498114982149831498414985149861498714988149891499014991149921499314994149951499614997149981499915000150011500215003150041500515006150071500815009150101501115012150131501415015150161501715018150191502015021150221502315024150251502615027150281502915030150311503215033150341503515036150371503815039150401504115042150431504415045150461504715048150491505015051150521505315054150551505615057150581505915060150611506215063150641506515066150671506815069150701507115072150731507415075150761507715078150791508015081150821508315084150851508615087150881508915090150911509215093150941509515096150971509815099151001510115102151031510415105151061510715108151091511015111151121511315114151151511615117151181511915120151211512215123151241512515126151271512815129151301513115132151331513415135151361513715138151391514015141151421514315144151451514615147151481514915150151511515215153151541515515156151571515815159151601516115162151631516415165151661516715168151691517015171151721517315174151751517615177151781517915180151811518215183151841518515186151871518815189151901519115192151931519415195151961519715198151991520015201152021520315204152051520615207152081520915210152111521215213152141521515216152171521815219152201522115222152231522415225152261522715228152291523015231152321523315234152351523615237152381523915240152411524215243152441524515246152471524815249152501525115252152531525415255152561525715258152591526015261152621526315264152651526615267152681526915270152711527215273152741527515276152771527815279152801528115282152831528415285152861528715288152891529015291152921529315294152951529615297152981529915300153011530215303153041530515306153071530815309153101531115312153131531415315153161531715318153191532015321153221532315324153251532615327153281532915330153311533215333153341533515336153371533815339153401534115342153431534415345153461534715348153491535015351153521535315354153551535615357153581535915360153611536215363153641536515366153671536815369153701537115372153731537415375153761537715378153791538015381153821538315384153851538615387153881538915390153911539215393153941539515396153971539815399154001540115402154031540415405154061540715408154091541015411154121541315414154151541615417154181541915420154211542215423154241542515426154271542815429154301543115432154331543415435154361543715438154391544015441154421544315444154451544615447154481544915450154511545215453154541545515456154571545815459154601546115462154631546415465154661546715468154691547015471154721547315474154751547615477154781547915480154811548215483154841548515486154871548815489154901549115492154931549415495154961549715498154991550015501155021550315504155051550615507155081550915510155111551215513155141551515516155171551815519155201552115522155231552415525155261552715528155291553015531155321553315534155351553615537155381553915540155411554215543155441554515546155471554815549155501555115552155531555415555155561555715558155591556015561155621556315564155651556615567155681556915570155711557215573155741557515576155771557815579155801558115582155831558415585155861558715588155891559015591155921559315594155951559615597155981559915600156011560215603156041560515606156071560815609156101561115612156131561415615156161561715618156191562015621156221562315624156251562615627156281562915630156311563215633156341563515636156371563815639156401564115642156431564415645156461564715648156491565015651156521565315654156551565615657156581565915660156611566215663156641566515666156671566815669156701567115672156731567415675156761567715678156791568015681156821568315684156851568615687156881568915690156911569215693156941569515696156971569815699157001570115702157031570415705157061570715708157091571015711157121571315714157151571615717157181571915720157211572215723157241572515726157271572815729157301573115732157331573415735157361573715738157391574015741157421574315744157451574615747157481574915750157511575215753157541575515756157571575815759157601576115762157631576415765157661576715768157691577015771157721577315774157751577615777157781577915780157811578215783157841578515786157871578815789157901579115792157931579415795157961579715798157991580015801158021580315804158051580615807158081580915810158111581215813158141581515816158171581815819158201582115822158231582415825158261582715828158291583015831158321583315834158351583615837158381583915840158411584215843158441584515846158471584815849158501585115852158531585415855158561585715858158591586015861158621586315864158651586615867158681586915870158711587215873158741587515876158771587815879158801588115882158831588415885158861588715888158891589015891158921589315894158951589615897158981589915900159011590215903159041590515906159071590815909159101591115912159131591415915159161591715918159191592015921159221592315924159251592615927159281592915930159311593215933159341593515936159371593815939159401594115942159431594415945159461594715948159491595015951159521595315954159551595615957159581595915960159611596215963159641596515966159671596815969159701597115972159731597415975159761597715978159791598015981159821598315984159851598615987159881598915990159911599215993159941599515996159971599815999160001600116002160031600416005160061600716008160091601016011160121601316014160151601616017160181601916020160211602216023160241602516026160271602816029160301603116032160331603416035160361603716038160391604016041160421604316044160451604616047160481604916050160511605216053160541605516056160571605816059160601606116062160631606416065160661606716068160691607016071160721607316074160751607616077160781607916080160811608216083160841608516086160871608816089160901609116092160931609416095160961609716098160991610016101161021610316104161051610616107161081610916110161111611216113161141611516116161171611816119161201612116122161231612416125161261612716128161291613016131161321613316134161351613616137161381613916140161411614216143161441614516146161471614816149161501615116152161531615416155161561615716158161591616016161161621616316164161651616616167161681616916170161711617216173161741617516176161771617816179161801618116182161831618416185161861618716188161891619016191161921619316194161951619616197161981619916200162011620216203162041620516206162071620816209162101621116212162131621416215162161621716218162191622016221162221622316224162251622616227162281622916230162311623216233162341623516236162371623816239162401624116242162431624416245162461624716248162491625016251162521625316254162551625616257162581625916260162611626216263162641626516266162671626816269162701627116272162731627416275162761627716278162791628016281162821628316284162851628616287162881628916290162911629216293162941629516296162971629816299163001630116302163031630416305163061630716308163091631016311163121631316314163151631616317163181631916320163211632216323163241632516326163271632816329163301633116332163331633416335163361633716338163391634016341163421634316344163451634616347163481634916350163511635216353163541635516356163571635816359163601636116362163631636416365163661636716368163691637016371163721637316374163751637616377163781637916380163811638216383163841638516386163871638816389163901639116392163931639416395163961639716398163991640016401164021640316404164051640616407164081640916410164111641216413164141641516416164171641816419164201642116422164231642416425164261642716428164291643016431164321643316434164351643616437164381643916440164411644216443164441644516446164471644816449164501645116452164531645416455164561645716458164591646016461164621646316464164651646616467164681646916470164711647216473164741647516476164771647816479164801648116482164831648416485164861648716488164891649016491164921649316494164951649616497164981649916500165011650216503165041650516506165071650816509165101651116512165131651416515165161651716518165191652016521165221652316524165251652616527165281652916530165311653216533165341653516536165371653816539165401654116542165431654416545165461654716548165491655016551165521655316554165551655616557165581655916560165611656216563165641656516566165671656816569165701657116572165731657416575165761657716578165791658016581165821658316584165851658616587165881658916590165911659216593165941659516596165971659816599166001660116602166031660416605166061660716608166091661016611166121661316614166151661616617166181661916620166211662216623166241662516626166271662816629166301663116632166331663416635166361663716638166391664016641166421664316644166451664616647166481664916650166511665216653166541665516656166571665816659166601666116662166631666416665166661666716668166691667016671166721667316674166751667616677166781667916680166811668216683166841668516686166871668816689166901669116692166931669416695166961669716698166991670016701167021670316704167051670616707167081670916710167111671216713167141671516716167171671816719167201672116722167231672416725167261672716728167291673016731167321673316734167351673616737167381673916740167411674216743167441674516746167471674816749167501675116752167531675416755167561675716758167591676016761167621676316764167651676616767167681676916770167711677216773167741677516776167771677816779167801678116782167831678416785167861678716788167891679016791167921679316794167951679616797167981679916800168011680216803168041680516806168071680816809168101681116812168131681416815168161681716818168191682016821168221682316824168251682616827168281682916830168311683216833168341683516836168371683816839168401684116842168431684416845168461684716848168491685016851168521685316854168551685616857168581685916860168611686216863168641686516866168671686816869168701687116872168731687416875168761687716878168791688016881168821688316884168851688616887168881688916890168911689216893168941689516896168971689816899169001690116902169031690416905169061690716908169091691016911169121691316914169151691616917169181691916920169211692216923169241692516926169271692816929169301693116932169331693416935169361693716938169391694016941169421694316944169451694616947169481694916950169511695216953169541695516956169571695816959169601696116962169631696416965169661696716968169691697016971169721697316974169751697616977169781697916980169811698216983169841698516986169871698816989169901699116992169931699416995169961699716998169991700017001170021700317004170051700617007170081700917010170111701217013170141701517016170171701817019170201702117022170231702417025170261702717028170291703017031170321703317034170351703617037170381703917040170411704217043170441704517046170471704817049170501705117052170531705417055170561705717058170591706017061170621706317064170651706617067170681706917070170711707217073170741707517076170771707817079170801708117082170831708417085170861708717088170891709017091170921709317094170951709617097170981709917100171011710217103171041710517106171071710817109171101711117112171131711417115171161711717118171191712017121171221712317124171251712617127171281712917130171311713217133171341713517136171371713817139171401714117142171431714417145171461714717148171491715017151171521715317154171551715617157171581715917160171611716217163171641716517166171671716817169171701717117172171731717417175171761717717178171791718017181171821718317184171851718617187171881718917190171911719217193171941719517196171971719817199172001720117202172031720417205172061720717208172091721017211172121721317214172151721617217172181721917220172211722217223172241722517226172271722817229172301723117232172331723417235172361723717238172391724017241172421724317244172451724617247172481724917250172511725217253172541725517256172571725817259172601726117262172631726417265172661726717268172691727017271172721727317274172751727617277172781727917280172811728217283172841728517286172871728817289172901729117292172931729417295172961729717298172991730017301173021730317304173051730617307173081730917310173111731217313173141731517316173171731817319173201732117322173231732417325173261732717328173291733017331173321733317334173351733617337173381733917340173411734217343173441734517346173471734817349173501735117352173531735417355173561735717358173591736017361173621736317364173651736617367173681736917370173711737217373173741737517376173771737817379173801738117382173831738417385173861738717388173891739017391173921739317394173951739617397173981739917400174011740217403174041740517406174071740817409174101741117412174131741417415174161741717418174191742017421174221742317424174251742617427174281742917430174311743217433174341743517436174371743817439174401744117442174431744417445174461744717448174491745017451174521745317454174551745617457174581745917460174611746217463174641746517466174671746817469174701747117472174731747417475174761747717478174791748017481174821748317484174851748617487174881748917490174911749217493174941749517496174971749817499175001750117502175031750417505175061750717508175091751017511175121751317514175151751617517175181751917520175211752217523175241752517526175271752817529175301753117532175331753417535175361753717538175391754017541175421754317544175451754617547175481754917550175511755217553175541755517556175571755817559175601756117562175631756417565175661756717568175691757017571175721757317574175751757617577175781757917580175811758217583175841758517586175871758817589175901759117592175931759417595175961759717598175991760017601176021760317604176051760617607176081760917610176111761217613176141761517616176171761817619176201762117622176231762417625176261762717628176291763017631176321763317634176351763617637176381763917640176411764217643176441764517646176471764817649176501765117652176531765417655176561765717658176591766017661176621766317664176651766617667176681766917670176711767217673176741767517676176771767817679176801768117682176831768417685176861768717688176891769017691176921769317694176951769617697176981769917700177011770217703177041770517706177071770817709177101771117712177131771417715177161771717718177191772017721177221772317724177251772617727177281772917730177311773217733177341773517736177371773817739177401774117742177431774417745177461774717748177491775017751177521775317754177551775617757177581775917760177611776217763177641776517766177671776817769177701777117772177731777417775177761777717778177791778017781177821778317784177851778617787177881778917790177911779217793177941779517796177971779817799178001780117802178031780417805178061780717808178091781017811178121781317814178151781617817178181781917820178211782217823178241782517826178271782817829178301783117832178331783417835178361783717838178391784017841178421784317844178451784617847178481784917850178511785217853178541785517856178571785817859178601786117862178631786417865178661786717868178691787017871178721787317874178751787617877178781787917880178811788217883178841788517886178871788817889178901789117892178931789417895178961789717898178991790017901179021790317904179051790617907179081790917910179111791217913179141791517916179171791817919179201792117922179231792417925179261792717928179291793017931179321793317934179351793617937179381793917940179411794217943179441794517946179471794817949179501795117952179531795417955179561795717958179591796017961179621796317964179651796617967179681796917970179711797217973179741797517976179771797817979179801798117982179831798417985179861798717988179891799017991179921799317994179951799617997179981799918000180011800218003180041800518006180071800818009180101801118012180131801418015180161801718018180191802018021180221802318024180251802618027180281802918030180311803218033180341803518036180371803818039180401804118042180431804418045180461804718048180491805018051180521805318054180551805618057180581805918060180611806218063180641806518066180671806818069180701807118072180731807418075180761807718078180791808018081180821808318084180851808618087180881808918090180911809218093180941809518096180971809818099181001810118102181031810418105181061810718108181091811018111181121811318114181151811618117181181811918120181211812218123181241812518126181271812818129181301813118132181331813418135181361813718138181391814018141181421814318144181451814618147181481814918150181511815218153181541815518156181571815818159181601816118162181631816418165181661816718168181691817018171181721817318174181751817618177181781817918180181811818218183181841818518186181871818818189181901819118192181931819418195181961819718198181991820018201182021820318204182051820618207182081820918210182111821218213182141821518216182171821818219182201822118222182231822418225182261822718228182291823018231182321823318234182351823618237182381823918240182411824218243182441824518246182471824818249182501825118252182531825418255182561825718258182591826018261182621826318264182651826618267182681826918270182711827218273182741827518276182771827818279182801828118282182831828418285182861828718288182891829018291182921829318294182951829618297182981829918300183011830218303183041830518306183071830818309183101831118312183131831418315183161831718318183191832018321183221832318324183251832618327183281832918330183311833218333183341833518336183371833818339183401834118342183431834418345183461834718348183491835018351183521835318354183551835618357183581835918360183611836218363183641836518366183671836818369183701837118372183731837418375183761837718378183791838018381183821838318384183851838618387183881838918390183911839218393183941839518396183971839818399184001840118402184031840418405184061840718408184091841018411184121841318414184151841618417184181841918420184211842218423184241842518426184271842818429184301843118432184331843418435184361843718438184391844018441184421844318444184451844618447184481844918450184511845218453184541845518456184571845818459184601846118462184631846418465184661846718468184691847018471184721847318474184751847618477184781847918480184811848218483184841848518486184871848818489184901849118492184931849418495184961849718498184991850018501185021850318504185051850618507185081850918510185111851218513185141851518516185171851818519185201852118522185231852418525185261852718528185291853018531185321853318534185351853618537185381853918540185411854218543185441854518546185471854818549185501855118552185531855418555185561855718558185591856018561185621856318564185651856618567185681856918570185711857218573185741857518576185771857818579185801858118582185831858418585185861858718588185891859018591185921859318594185951859618597185981859918600186011860218603186041860518606186071860818609186101861118612186131861418615186161861718618186191862018621186221862318624186251862618627186281862918630186311863218633186341863518636186371863818639186401864118642186431864418645186461864718648186491865018651186521865318654186551865618657186581865918660186611866218663186641866518666186671866818669186701867118672186731867418675186761867718678186791868018681186821868318684186851868618687186881868918690186911869218693186941869518696186971869818699187001870118702187031870418705187061870718708187091871018711187121871318714187151871618717187181871918720187211872218723187241872518726187271872818729187301873118732187331873418735187361873718738187391874018741187421874318744187451874618747187481874918750187511875218753187541875518756187571875818759187601876118762187631876418765187661876718768187691877018771187721877318774187751877618777187781877918780187811878218783187841878518786187871878818789187901879118792187931879418795187961879718798187991880018801188021880318804188051880618807188081880918810188111881218813188141881518816188171881818819188201882118822188231882418825188261882718828188291883018831188321883318834188351883618837188381883918840188411884218843188441884518846188471884818849188501885118852188531885418855188561885718858188591886018861188621886318864188651886618867188681886918870188711887218873188741887518876188771887818879188801888118882188831888418885188861888718888188891889018891188921889318894188951889618897188981889918900189011890218903189041890518906189071890818909189101891118912189131891418915189161891718918189191892018921189221892318924189251892618927189281892918930189311893218933189341893518936189371893818939189401894118942189431894418945189461894718948189491895018951189521895318954189551895618957189581895918960189611896218963189641896518966189671896818969189701897118972189731897418975189761897718978189791898018981189821898318984189851898618987189881898918990189911899218993189941899518996189971899818999190001900119002190031900419005190061900719008190091901019011190121901319014190151901619017190181901919020190211902219023190241902519026190271902819029190301903119032190331903419035190361903719038190391904019041190421904319044190451904619047190481904919050190511905219053190541905519056190571905819059190601906119062190631906419065190661906719068190691907019071190721907319074190751907619077190781907919080190811908219083190841908519086190871908819089190901909119092190931909419095190961909719098190991910019101191021910319104191051910619107191081910919110191111911219113191141911519116191171911819119191201912119122191231912419125191261912719128191291913019131191321913319134191351913619137191381913919140191411914219143191441914519146191471914819149191501915119152191531915419155191561915719158191591916019161191621916319164191651916619167191681916919170191711917219173191741917519176191771917819179191801918119182191831918419185191861918719188191891919019191191921919319194191951919619197191981919919200192011920219203192041920519206192071920819209192101921119212192131921419215192161921719218192191922019221192221922319224192251922619227192281922919230192311923219233192341923519236192371923819239192401924119242192431924419245192461924719248192491925019251192521925319254192551925619257192581925919260192611926219263192641926519266192671926819269192701927119272192731927419275192761927719278192791928019281192821928319284192851928619287192881928919290192911929219293192941929519296192971929819299193001930119302193031930419305193061930719308193091931019311193121931319314193151931619317193181931919320193211932219323193241932519326193271932819329193301933119332193331933419335193361933719338193391934019341193421934319344193451934619347193481934919350193511935219353193541935519356193571935819359193601936119362193631936419365193661936719368193691937019371193721937319374193751937619377193781937919380193811938219383193841938519386193871938819389193901939119392193931939419395193961939719398193991940019401194021940319404194051940619407194081940919410194111941219413194141941519416194171941819419194201942119422194231942419425194261942719428194291943019431194321943319434194351943619437194381943919440194411944219443194441944519446194471944819449194501945119452194531945419455194561945719458194591946019461194621946319464194651946619467194681946919470194711947219473194741947519476194771947819479194801948119482194831948419485194861948719488194891949019491194921949319494194951949619497194981949919500195011950219503195041950519506195071950819509195101951119512195131951419515195161951719518195191952019521195221952319524195251952619527195281952919530195311953219533195341953519536195371953819539195401954119542195431954419545195461954719548195491955019551195521955319554195551955619557195581955919560195611956219563195641956519566195671956819569195701957119572195731957419575195761957719578195791958019581195821958319584195851958619587195881958919590195911959219593195941959519596195971959819599196001960119602196031960419605196061960719608196091961019611196121961319614196151961619617196181961919620196211962219623196241962519626196271962819629196301963119632196331963419635196361963719638196391964019641196421964319644196451964619647196481964919650196511965219653196541965519656196571965819659196601966119662196631966419665196661966719668196691967019671196721967319674196751967619677196781967919680196811968219683196841968519686196871968819689196901969119692196931969419695196961969719698196991970019701197021970319704197051970619707197081970919710197111971219713197141971519716197171971819719197201972119722197231972419725197261972719728197291973019731197321973319734197351973619737197381973919740197411974219743197441974519746197471974819749197501975119752197531975419755197561975719758197591976019761197621976319764197651976619767197681976919770197711977219773197741977519776197771977819779197801978119782197831978419785197861978719788197891979019791197921979319794197951979619797197981979919800198011980219803198041980519806198071980819809198101981119812198131981419815198161981719818198191982019821198221982319824198251982619827198281982919830198311983219833198341983519836198371983819839198401984119842198431984419845198461984719848198491985019851198521985319854198551985619857198581985919860198611986219863198641986519866198671986819869198701987119872198731987419875198761987719878198791988019881198821988319884198851988619887198881988919890198911989219893198941989519896198971989819899199001990119902199031990419905199061990719908199091991019911199121991319914199151991619917199181991919920199211992219923199241992519926199271992819929199301993119932199331993419935199361993719938199391994019941199421994319944199451994619947199481994919950199511995219953199541995519956199571995819959199601996119962199631996419965199661996719968199691997019971199721997319974199751997619977199781997919980199811998219983199841998519986199871998819989199901999119992199931999419995199961999719998199992000020001200022000320004200052000620007200082000920010200112001220013200142001520016200172001820019200202002120022200232002420025200262002720028200292003020031200322003320034200352003620037200382003920040200412004220043200442004520046200472004820049200502005120052200532005420055200562005720058200592006020061200622006320064200652006620067200682006920070200712007220073200742007520076200772007820079200802008120082200832008420085200862008720088200892009020091200922009320094200952009620097200982009920100201012010220103201042010520106201072010820109201102011120112 |
- unit MainFrm;
- interface
- {$INCLUDE LXTalk.inc}
- uses
- SingleBorderHintWindow, HardwareID, WinSvc, HttpApp, RealICQSkinFrm, MyUtils,
- GIFImage, MMSystem, RealICQUtils, RealICQDBHistory, Windows, Messages,
- SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, Menus,
- ComCtrls, ExtCtrls, ImgList, Buttons, ToolWin, StdCtrls, OleCtrls, SHDocVw,
- MSHTML, XMLDoc, XMLIntf, StrUtils, ActiveX, ShellAPI, ActnMan, ActnList,
- XPStyleActnCtrls, ActnCtrls, ActnMenus, ActnColorMaps, RealICQNavigater,
- RealICQContacterListView, RealICQContacterTreeView, RealICQUIColor,
- RealICQPageControl, RealICQColors, MD5, WNDES, FileCtrl, StdActns,
- RealICQClient, StdStyleActnCtrls, ExtDlgs, RealICQButton, ActnPopup,
- CustomizeDlg, MyInputBoxFrm, RealICQSpeedButton, AppEvnts, xFonts, jpeg,
- DateUtils, IniFiles, RealICQMultiLanguage, Math, Types,
- RealICQNetWorkDiskClient, Tabs, RealICQSingleImageButton,
- RealICQNoBorderPageControl, ResponsionStreamTransmitter,
- NetWorkFileTransmitter, TransmitDirection, DESUnit, BitmapButton, Registry,
- PsAPI, TLHelp32, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient,
- IdHTTP, QueryIpWry, RealICQHoverImage, XXTEA, AddUserFrm, AddGroupFrm,
- AddrBookUserFrm, ImportGuideFrm, DownloadFileFromWeb, MessageBoxFrm, aeslib,
- pngimage, SuperObject, EncdDecd, IdMultiPartFormData, cefvcl, RealICQModel,
- IdScheduler, IdSchedulerOfThread, IdSchedulerOfThreadPool;
- const
- //http://10.41.220.59:8080/account/sso?LoginName=&Password=&URL=/Widgets/home/index
- //老的
- BaseURL = '/login.aspx?LoginName=%s&Password=%s&URL=%s';
- //新的
- NewBaseURL = '/account/sso?LoginName=%s&Password=%s&URL=%s';
- LoginURL = '';
- InBoxURL = ''; //'/widgets/home/index';
-
ReadMessageURL = '/Messages/Default.aspx?url=';
- GetWeatherMessage = WM_APP + 157;
- //DefaultUpdateLogPostUrl = 'http://360.myreda.com/Insert.aspx';
- MainTabImageDir = 'Images\TabImage\';
- SMSURL = '/Messages/SMSManage.aspx';
- MiniPageURL = '/Messages/MiniPage.aspx?LoginName=%s';
- AddRemarkURL = '/Messages/Default.aspx?url=SMSManage.aspx?url=EditMemorandum.aspx?Contents=%s';
- SNSHomePage = '/SNS/Login.aspx?LoginName=%s&Password=%s&DestUser=%s';
- ShowSNS = False;
- TeamSharePic: string = 'Images\Share.png';
- LoginingGif: string = 'Images\Logining.gif';
- DefaultIcon: string = 'Images\Small\DefaultIcon.ico';
- TeamIcon: string = 'Images\Small\Team.ico';
- SystemMessageIcon: string = 'Images\Small\SystemMessage.ico';
- SMSMessageIcon: string = 'Images\Small\SMS.ico';
- SNSIcon: string = 'Images\Small\SNS.ico';
- CancelIcon: string = 'Images\Cancel.ico';
- UpBMP: string = 'Images\Upload.png';
- DownBMP: string = 'Images\Download.png';
- SimpleMessagePicture: string = 'Images\SysMsg\SimpleMessage.bmp';
- SystemMessagePicture: string = 'Images\SysMsg\SystemMessage.bmp';
- TeamPicture: string = 'Images\Small\Team.bmp';
- SearchPicture: string = 'Images\Search.bmp';
- Action_Paste_GIF: string = 'Images\action_paste.png';
- WorldCamPicture: string = 'Images\worldCam.jpg';
- //VideoBorderBig: String = 'Images\VideoBorderBig.bmp';
- //VideoBorderMiddle: String = 'Images\VideoBorderMiddle.bmp';
- //VideoBorderSmall: String = 'Images\VideoBorderSmall.bmp';
- DefaultTeamPicture: string = 'Images\Small\TeamHead.png';
- DefaultPictureSecurity: string = 'Images\Small\Security.bmp';
- DefaultPicture: string = 'Images\Small\DefaultHeadImage_96.png';
- DefaultPictureBig44: string = 'Images\Small\DefaultHeadImage_44.png';
- DefaultPictureBig: string = 'Images\Small\DefaultHeadImage_48.png';
- DefaultPictureMiddle: string = 'Images\Small\DefaultHeadImage_24.png';
- DefaultPictureSmall: string = 'Images\Small\DefaultHeadImage_16.png';
- DefaultPictureBigOffline: string = 'Images\Small\DefaultHeadImageOffline_48.png';
- DefaultPictureMiddleOffline: string = 'Images\Small\DefaultHeadImageOffline_24.png';
- DefaultPictureSmallOffline: string = 'Images\Small\DefaultHeadImageOffline_16.png';
- LeavePicture: string = 'Images\Small\Leave.bmp';
- CameraIcon: string = 'Images\Small\Camera.ico';
- CameraIconBitmap: string = 'Images\Small\Camera.bmp';
- SelectedItemBackgroud: string = 'Images\Small\ItemBack.bmp';
- AddFriendIcon: string = 'Images\Small\AddFriend.ico';
- TelephoneIcon: string = 'Images\Small\Telephone.ico';
- MobilePhoneIcon: string = 'Images\Small\MobilePhone.ico';
- EmailIcon: string = 'Images\Small\Email.ico';
- SMSIcon: string = 'Images\Small\SMS.ico';
- SMSBMP: string = 'Images\Small\SMS.bmp';
- SMSSendOK: string = 'Images\SMSSendOK.ico';
- SMSSending: string = 'Images\SMSSending.gif';
- SMSSendError: string = 'Images\SMSSendError.ico';
- BranchExpandedPicture: string = 'Images\OpenFolder.ico';
- BranchCollapsedPicture: string = 'Images\CloseFolder.ico';
- BranchCollapsedBMP: string = 'Images\CloseFolder.png';
- BranchClosedButtonPicture: string = 'Images\ClosedButton.bmp';
- BranchOpenedButtonPicture: string = 'Images\OpenedButton.bmp';
- GroupOpenedButtonPicture: string = 'Images\FriendOpenedButton.bmp';
- GroupClosedButtonPicture: string = 'Images\FriendClosedButton.bmp';
- ScrollBarBottomButtonPicture: string = 'Images\VScrollBar\ScrollBarBottomButton.bmp';
- ScrollBarBottomButtonDownPicture: string = 'Images\VScrollBar\ScrollBarBottomButtonDown.bmp';
- ScrollBarBottomButtonHoverPicture: string = 'Images\VScrollBar\ScrollBarBottomButtonHover.bmp';
- ScrollBarTopButtonPicture: string = 'Images\VScrollBar\ScrollBarTopButton.bmp';
- ScrollBarTopButtonDownPicture: string = 'Images\VScrollBar\ScrollBarTopButtonDown.bmp';
- ScrollBarTopButtonHoverPicture: string = 'Images\VScrollBar\ScrollBarTopButtonHover.bmp';
- ScrollBarTrackButtonBottomPicture: string = 'Images\VScrollBar\ScrollBarTrackButtonBottom.bmp';
- ScrollBarTrackButtonBottomDownPicture: string = 'Images\VScrollBar\ScrollBarTrackButtonBottomDown.bmp';
- ScrollBarTrackButtonBottomHoverPicture: string = 'Images\VScrollBar\ScrollBarTrackButtonBottomHover.bmp';
- ScrollBarTrackButtonMiddlePicture: string = 'Images\VScrollBar\ScrollBarTrackButtonMiddle.bmp';
- ScrollBarTrackButtonMiddleDownPicture: string = 'Images\VScrollBar\ScrollBarTrackButtonMiddleDown.bmp';
- ScrollBarTrackButtonMiddleHoverPicture: string = 'Images\VScrollBar\ScrollBarTrackButtonMiddleHover.bmp';
- ScrollBarTrackButtonTopPicture: string = 'Images\VScrollBar\ScrollBarTrackButtonTop.bmp';
- ScrollBarTrackButtonTopDownPicture: string = 'Images\VScrollBar\ScrollBarTrackButtonTopDown.bmp';
- ScrollBarTrackButtonTopHoverPicture: string = 'Images\VScrollBar\ScrollBarTrackButtonTopHover.bmp';
- ScrollBackgroundPicture: string = 'Images\VScrollBar\ScrollBackground.bmp';
- ScrollBarButtonPicture: string = 'Images\VScrollBar\MiddleButton.bmp';
- ConfigXMLFilePath: string = 'XML\';
- UpdateLogXMLFile: string = 'Online.xml';
- GroupConfigXMLFile: string = 'GroupConfig.XML';
- StyleConfigXMLFile: string = 'StyleConfig.XML';
- DefaultConfigXMLFile: string = 'DefaultConfig.XML';
- InputConfigXMLFile: string = 'InputConfig.XML';
- HintAndSoundConfigXMLFile: string = 'HintAndSoundConfig.XML';
- ReceiveFileConfigXMLFile: string = 'ReceiveFileConfig.XML';
- SystemMessagesCounterXMLFile: string = 'SystemMessagesCounter.XML';
- SafeConfigXMLFile: string = 'SafeConfig.XML';
- AutoUpdateConfigXMLFile: string = 'AutoUpdateConfig.XML';
- WindowColorsXMLFile: string = 'WindowColors.XML';
- BackGroundImagesXMLFile: string = 'BackGroundImages.XML';
- HotKeyConfigXMLFile: string = 'HotKeyConfig.XML';
- WebPanelsXMLFile: string = 'WebPanels.XML';
- OfflineAutoResponseConfigXMLFile: string = 'OfflineAutoResponseConfig.XML';
- AddrBookConfig: string = 'AddrBookConfig.XML';
- SysMsgInterfaceConfig: string = 'SysMsgInterfaceConfig.XML';
- MessageHistoryDBFile: string = 'Users\History.dat';
- PersonalMessageHistoryDBFile: string = 'MessageHistory.DAT';
- FaceSmallBMP: string = '_SmallBMP';
- FacePreviewBMP: string = '_PreviewBMP';
- FaceSmallSize: Integer = 28;
- FacePreviewSize: Integer = 92;
- ShakeWindowSound: string = 'Sound\nudge.wav';
- //未读消息类型，未读消息集合（StringList）中的字符串值为以下常量的值时,表示为特殊的系统消息
- TeamMessageID: string = '_____________________________________TeamMessage_';
- SystemMessageID: string = '___________________________________SystemMessage_';
- SMSMessageID: string = '______________________________________SMSMessage_';
- AVSetExeFile: string = 'Plugin\AVSet.EXE';
- HelpCHMFile: string = 'HELP.CHM';
- SystemFaceGroup: string = '默认表情';
- NOFaceCategory: string = '未分组表情';
- type
- TInvokeDLLForm = function(App: TApplication; hWnd: THandle; pCall: Pointer; AReceiver: PChar; AColor: TColor): TForm; stdcall;
- TWebPanel = class;
- TSystemMessageType = (smSimple = 1, smSystemMessage = 2);
- TRecvFileSafeLevel = (fsHigh = 0, fsMiddle = 1, fsLow = 2);
- THidePosition = (hpNone = 0, hpLeft = 1, hpTop = 2, hpRight = 3);
- //定义保存通讯录组和用户的数据结构
- TManageGroupMessage = class
- private
- MessageId: string;
- FGroupID: string;
- FParentID: string;
- FGroupName: string;
- end;
- TManageGroupMemberMessage = class
- private
- MessageId: string;
- FId: string;
- FDisplayName: string;
- FNickName: string;
- FMobile: string;
- FTel: string;
- FEmail: string;
- FRemark: string;
- FGroupId: string;
- end;
- TServerInfo = class
- public
- ServerId, ServerName: string;
- end;
- //检测指定的进程是否运行
- TCheckRunProcessThread = class(TThread)
- private
- ProgramName: string;
- ProcessPath: string;
- protected
- function GetProcessPath(ProcessID: DWORD): string;
- function FindProcess(AFileName: string): boolean;
- procedure Execute; override;
- public
- constructor Create(AProgramName, AProcessPath: string);
- end;
- TThreadPost = class(TThread) //以Post方式提交数据到web页面线程类。
- private
- FUrl: string;
- FContent: string;
- protected
- procedure Execute; override;
- public
- constructor Create(URL, Content: string); overload;
- end;
- TUploadMission = class;
- TNDMissionType = (mtDir, mtFile);
- TMainForm = class(TRealICQSkinForm)
- actLoginAs: TAction;
- actLogout: TAction;
- actPersonalSet: TAction;
- actChangePass: TAction;
- actClose: TAction;
- actOnline: TAction;
- actHidden: TAction;
- actOffline: TAction;
- actBusy: TAction;
- actMute: TAction;
- actLeave: TAction;
- actOtherState: TAction;
- actFindUsers: TAction;
- actSaveList: TAction;
- actLoadList: TAction;
- actShowBigHeadImage: TAction;
- actShowSmallHeadImage: TAction;
- actShowNormalHeadImage: TAction;
- actShowLoginName: TAction;
- actShowDisplayName: TAction;
- actShowAllName: TAction;
- actAlwaysOnTop: TAction;
- actMsgManager: TAction;
- actAVSet: TAction;
- actOptions: TAction;
- actHelp: TAction;
- actAbout: TAction;
- ImgLstPageControl: TImageList;
- ActionManager: TActionManager;
- ColorDialog: TColorDialog;
- actQuit: TAction;
- RealICQClient: TRealICQClient;
- actReg: TAction;
- actConnectSet: TAction;
- ppUserItemRightMenu: TPopupActionBar;
- actSendMessage: TAction;
- actDelFriend: TAction;
- miSendMessage: TMenuItem;
- N1: TMenuItem;
- miDelFriend: TMenuItem;
- actShowGroup: TAction;
- actGroupManager: TAction;
- actShowMiddleHeadImage: TAction;
- actRemoveUser: TAction;
- actShowStrangers: TAction;
- actShowBlacklists: TAction;
- actShowTeams: TAction;
- actShowLatests: TAction;
- ppChangeStates: TPopupActionBar;
- O1: TMenuItem;
- H1: TMenuItem;
- N3: TMenuItem;
- N5: TMenuItem;
- N10: TMenuItem;
- ImgLstTrayIcon: TImageList;
- ppTrayIcon: TPopupActionBar;
- MenuItem12: TMenuItem;
- REALICQ1: TMenuItem;
- X1: TMenuItem;
- M1: TMenuItem;
- S1: TMenuItem;
- I1: TMenuItem;
- N19: TMenuItem;
- N20: TMenuItem;
- actOpenMainForm: TAction;
- TimerForCheckDblClick: TTimer;
- ppColors: TPopupActionBar;
- MenuItem18: TMenuItem;
- miMoreColors: TMenuItem;
- ImgLstColors: TImageList;
- pnlAll: TPanel;
- actSeeInformation: TAction;
- miSeeUserInformation: TMenuItem;
- N21: TMenuItem;
- miSkins: TMenuItem;
- pnlLogout: TPanel;
- pnlWorkArea: TPanel;
- pnlMiddle: TPanel;
- pnlClient: TPanel;
- TrayIcon: TTrayIcon;
- actShowGIFInMailForm: TAction;
- actShowGIFInTalkingForm: TAction;
- TimerForFlashTrayIcon: TTimer;
- ImgLstForFlashTrayIcon: TImageList;
- ApplicationEvents: TApplicationEvents;
- actCustomFacesManager: TAction;
- actOpenRecvFileDir: TAction;
- actCreateTeam: TAction;
- actSendTeamMessage: TAction;
- actSeeTeamInformation: TAction;
- actQuitTeam: TAction;
- actDisbandTeam: TAction;
- actQuitOrDisbandTeams: TAction;
- pnlAdvertisement: TPanel;
- pnlForWebBrowser: TPanel;
- WebBrowserForAdvertisement: TWebBrowser;
- pnlForHideWebBrowser: TPanel;
- TimerForShowSystemMessage: TTimer;
- actShowHistory: TAction;
- miShowHistory: TMenuItem;
- actShowTeamHistory: TAction;
- imgLogoutBK: TImage;
- imgLogoutBKTop: TImage;
- lblLoginNameTitle: TLabel;
- spLoginNameBorder: TShape;
- edLoginName: TEdit;
- lblLoginState: TLabel;
- lblPasswordTitle: TLabel;
- edPassword: TEdit;
- spPasswordBorder: TShape;
- lblLoginStateTitle: TLabel;
- spbLoginState: TRealICQSpeedButton;
- spbSavePassword: TRealICQSpeedButton;
- spbAutoLogin: TRealICQSpeedButton;
- lblRemoveMyLoginInfo: TLabel;
- lblNetworkConfig: TLabel;
- lblRegister: TLabel;
- ppLoginedUsers: TPopupActionBar;
- MenuItem4: TMenuItem;
- miClearLoginHistory: TMenuItem;
- ImgLstCheckStates: TImageList;
- ppLoginStates: TPopupActionBar;
- miOnline: TMenuItem;
- lblReConnect: TLabel;
- actChangeRemark: TAction;
- M2: TMenuItem;
- actShowRemark: TAction;
- TimerForCheckLogoutTimeout: TTimer;
- ImgLstForLogining: TImageList;
- TimerForLogining: TTimer;
- actShowTree: TAction;
- pnlWebSearch: TPanel;
- pnlWebSearchSplit: TPanel;
- ppContacterViewStyle: TPopupActionBar;
- Z1: TMenuItem;
- A1: TMenuItem;
- D1: TMenuItem;
- L1: TMenuItem;
- P1: TMenuItem;
- N22: TMenuItem;
- S2: TMenuItem;
- M3: TMenuItem;
- B1: TMenuItem;
- N23: TMenuItem;
- S3: TMenuItem;
- B2: TMenuItem;
- N24: TMenuItem;
- G1: TMenuItem;
- M4: TMenuItem;
- N25: TMenuItem;
- N26: TMenuItem;
- T1: TMenuItem;
- btLogin: TRealICQButton;
- ppLanguages: TPopupActionBar;
- imgLogo: TImage;
- TimerForHideMainForm: TTimer;
- //TimerForShowMainForm: TTimer;
- RealICQNetWorkDiskClient: TRealICQNetWorkDiskClient;
- ppNetWorkFile: TPopupActionBar;
- miNDNewDir: TMenuItem;
- miNDDelete: TMenuItem;
- N28: TMenuItem;
- miNDRename: TMenuItem;
- pnlMiddleClient: TPanel;
- pnlMiddleRight: TPanel;
- Spl: TSplitter;
- pnlMuiltiWeb: TPanel;
- pnlMuiltWebStatus: TPanel;
- lblIEStatus: TLabel;
- pnlMuiltiWebToolbar: TPanel;
- spbPrev: TRealICQSpeedButton;
- spbNext: TRealICQSpeedButton;
- spbStop: TRealICQSpeedButton;
- spbRefresh: TRealICQSpeedButton;
- spbAddToNA: TRealICQSpeedButton;
- Label2: TLabel;
- spbGo: TRealICQSingleImageButton;
- cbxURLInputer: TComboBoxEx;
- TabSetMuiltWeb: TTabSet;
- shpWebStatus: TShape;
- shpWebLeftBorder: TShape;
- UploadFileOpenDialog: TOpenDialog;
- ppNetWorkMisson: TPopupActionBar;
- miNDCancel: TMenuItem;
- DownloadFileSaveDialog: TSaveDialog;
- miNDDownload: TMenuItem;
- pgcMultiWeb: TRealICQNoBorderPageControl;
- ImgLstForShowHideRight: TImageList;
- ImgLstForIEAddress: TImageList;
- spbWebClose: TRealICQSpeedButton;
- imgWebToolBack: TImage;
- shpWebRightBorder: TShape;
- sbpNewWebTab: TRealICQSpeedButton;
- Bevel5: TBevel;
- actOfflieAutoResponse: TAction;
- L3: TMenuItem;
- imgBottomMenu: TImage;
- btMainMenu: TBitmapButton;
- spbAddFriend: TRealICQSpeedButton;
- pgcMainWorkArea: TTRealICQPageControl;
- tsContacters: TTabSheet;
- tsAddrBook: TTabSheet;
- tsNetWorkDisk: TTabSheet;
- pnlAddrBook: TPanel;
- pnlNDStateBar: TPanel;
- lblNDState: TLabel;
- lblNDSpaceSize: TLabel;
- pnlNDToolBar: TPanel;
- imgNDToolbarBack: TImage;
- spbNDNewDir: TRealICQSpeedButton;
- spbNDDelete: TRealICQSpeedButton;
- spbNDMoveUp: TRealICQSpeedButton;
- spbNDUpload: TRealICQSpeedButton;
- spbNDDownload: TRealICQSpeedButton;
- Bevel1: TBevel;
- Bevel2: TBevel;
- spbNDConnect: TRealICQSpeedButton;
- Bevel4: TBevel;
- Bevel3: TBevel;
- spbNDRefresh: TRealICQSpeedButton;
- spbNDCancelAll: TRealICQSpeedButton;
- spbNDDisconnect: TRealICQSpeedButton;
- pnlNetWorkFiles: TPanel;
- shpNDDirBorder: TShape;
- edNDDir: TEdit;
- pnlNDFiles: TPanel;
- SplitterNDMissions: TSplitter;
- pnlNDMissions: TPanel;
- PageControlNDMission: TRealICQNoBorderPageControl;
- tsUploadingFiles: TTabSheet;
- tsDownloadingFiles: TTabSheet;
- TabSetNDMissions: TTabSet;
- pnlTop: TPanel;
- imgTitleBackMiddle: TImage;
- shpHeadBack: TShape;
- imgHead: TImage;
- imgLeave: TImage;
- spbDisplayName: TRealICQSpeedButton;
- spbWatchword: TRealICQSpeedButton;
- shpWatchwordBorder: TShape;
- imgHeadImageBorder: TImage;
- spbSelUIColor: TRealICQSpeedButton;
- spbEmail: TRealICQSpeedButton;
- sbpSMS: TRealICQSpeedButton;
- edWatchword: TEdit;
- WebBrowserForEMail: TWebBrowser;
- spbHistroyMessage: TRealICQSpeedButton;
- imgLstContacterPageCtrl: TImageList;
- edFilterKeyword: TEdit;
- spbContacterViewStyle: TRealICQSpeedButton;
- spbCancelFilter: TRealICQSpeedButton;
- imgWeather: TImage;
- ppMainMenu: TPopupActionBar;
- miOpenRecvFileDir: TMenuItem;
- miCustomFacesManager: TMenuItem;
- miAVSet: TMenuItem;
- N31: TMenuItem;
- miLoginAs: TMenuItem;
- miSet: TMenuItem;
- miLogOut: TMenuItem;
- miQuit: TMenuItem;
- lblWeather: TLabel;
- lblWeatheren: TLabel;
- shpFilterBorder: TShape;
- pnlToolBar: TPanel;
- SysMsg: TRealICQHoverImage;
- MyContacters: TRealICQHoverImage;
- MyTeam: TRealICQHoverImage;
- MyFriend: TRealICQHoverImage;
- Latests: TRealICQHoverImage;
- pnlSearch: TPanel;
- ShpLeft: TShape;
- ShpRight: TShape;
- ShpBottom: TShape;
- ScrollBoxSearchUser: TScrollBox;
- spbPersonManage: TRealICQSpeedButton;
- MyContactersIcon: TRealICQHoverImage;
- SysMsgIcon: TRealICQHoverImage;
- MyFriendIcon: TRealICQHoverImage;
- MyTeamIcon: TRealICQHoverImage;
- LatestsIcon: TRealICQHoverImage;
- lblSearchResult: TLabel;
- lblWeatherCity: TLabel;
- tsCustomerService: TTabSheet;
- pnlCustomerServiceStatus: TPanel;
- lblCustomerServiceStatus: TLabel;
- Panel1: TPanel;
- ImageForCustomerTop: TImage;
- btCustomerLogin: TRealICQSpeedButton;
- Bevel8: TBevel;
- btCustomerLogout: TRealICQSpeedButton;
- btCustomerDisplayName: TRealICQSpeedButton;
- ppChangeCustomerState: TPopupActionBar;
- MenuItem5: TMenuItem;
- MenuItem7: TMenuItem;
- MenuItem8: TMenuItem;
- MenuItem9: TMenuItem;
- MenuItem10: TMenuItem;
- MenuItem11: TMenuItem;
- MenuItem13: TMenuItem;
- MenuItem15: TMenuItem;
- MenuItem16: TMenuItem;
- MenuItem17: TMenuItem;
- MenuItem19: TMenuItem;
- MenuItem21: TMenuItem;
- MenuItem22: TMenuItem;
- tsCustomers: TTabSheet;
- pnlCustomer: TPanel;
- ppServerList: TPopupActionBar;
- MenuItem20: TMenuItem;
- spbTelMeeting: TRealICQSpeedButton;
- ppSelCallTel: TPopupActionBar;
- miCallMobile: TMenuItem;
- miCallTel: TMenuItem;
- miChangePwd: TMenuItem;
- pnlAddrBkStateBar: TPanel;
- imgAddrBookToolbarBack: TImage;
- spbAddGroupUser: TRealICQSpeedButton;
- spbAddGroup: TRealICQSpeedButton;
- spbImportGroupUser: TRealICQSpeedButton;
- ScrollBoxAddrBook: TScrollBox;
- ppAddrBookList: TPopupActionBar;
- miAddGroup: TMenuItem;
- miUpdateGroup: TMenuItem;
- miDelGroup: TMenuItem;
- miAddGroupUser: TMenuItem;
- miUpdateGroupUser: TMenuItem;
- miDelGroupUser: TMenuItem;
- miCut: TMenuItem;
- miPaste: TMenuItem;
- pnlForTopMessage: TPanel;
- ShpHint: TShape;
- spbShowNotReadMessage: TRealICQSpeedButton;
- TimerForGetBranchOnlineStates: TTimer;
- TimerForGetBranchUsersOnlineStates: TTimer;
- btPrevLog: TRealICQSpeedButton;
- btNextLog: TRealICQSpeedButton;
- lblLogs: TLabel;
- lblLogsTitle: TLabel;
- TimerForShowSystemNotices: TTimer;
- btShowMiniPage: TRealICQSpeedButton;
- miSetRemark: TMenuItem;
- N29: TMenuItem;
- miImportGroupUser: TMenuItem;
- miGoSpace: TMenuItem;
- Label3: TLabel;
- pnlGroups: TPanel;
- pnlMoreUser: TPanel;
- ImgLoadingMoreBranchs: TImage;
- pnlSelectServer: TPanel;
- shpSearchMoreUser: TShape;
- spServerListBorder: TShape;
- spbSelectServer: TRealICQSpeedButton;
- spbRefreshBranchUsers: TRealICQSpeedButton;
- edtSearchMoreUser: TEdit;
- edServerList: TEdit;
- pnlSearchMoreUser: TPanel;
- ShpSearchLeft: TShape;
- ShpSearchRight: TShape;
- ShpSearchBottom: TShape;
- LblSearchHint: TLabel;
- ImgLogining: TImage;
- ScrollBoxSearchMoreUser: TScrollBox;
- ScrollBoxMoreUser: TScrollBox;
- pnlTeams: TPanel;
- spbFindTeam: TRealICQSpeedButton;
- spbCreateTeam: TRealICQSpeedButton;
- pnlTemp: TPanel;
- ScrollBoxContacters: TScrollBox;
- ScrollBoxLatests: TScrollBox;
- ScrollBoxMyFriend: TScrollBox;
- ScrollBoxTeam: TScrollBox;
- spbNetworkBackup: TRealICQSpeedButton;
- TimerForHideUserCard: TTimer;
- TimerForShowUserCard: TTimer;
- RealICQHoverImage1: TRealICQHoverImage;
- ImageListForStatBig: TImageList;
- ImageListForStatSmall: TImageList;
- M5: TMenuItem;
- actPhone: TAction;
- actRepast: TAction;
- actMeeting: TAction;
- N6: TMenuItem;
- N7: TMenuItem;
- N8: TMenuItem;
- miLeave: TMenuItem;
- miBusy: TMenuItem;
- miMute: TMenuItem;
- miHidden: TMenuItem;
- N9: TMenuItem;
- N11: TMenuItem;
- N12: TMenuItem;
- N13: TMenuItem;
- N14: TMenuItem;
- N15: TMenuItem;
- N16: TMenuItem;
- N17: TMenuItem;
- N18: TMenuItem;
- //spb360Safe: TRealICQSpeedButton;
- spbChangeLoginName: TRealICQSpeedButton;
- spbWinMeet: TRealICQSpeedButton;
- ppTeamListView: TPopupActionBar;
- MenuItem1: TMenuItem;
- MenuItem2: TMenuItem;
- H3: TMenuItem;
- miSendTeamSMS: TMenuItem;
- MenuItem3: TMenuItem;
- X2: TMenuItem;
- R1: TMenuItem;
- Q1: TMenuItem;
- //spb360SD: TRealICQSpeedButton;
- WebBrowserForPostWorkOrder: TWebBrowser;
- pnlLocked: TPanel;
- shp_lock_client: TShape;
- img_lock_headimage_border: TImage;
- img_lock_HeadPrev: TImage;
- img_lockback_top: TImage;
- btn_unlock: TRealICQSpeedButton;
- btn_lock_DisplayName: TRealICQSpeedButton;
- btn_lock: TMenuItem;
- miExportGroupUser: TMenuItem;
- SD: TSaveDialog;
- TimerForreconnectgroup: TTimer;
- ImgApp: TImage;
- btnCALogin: TRealICQSpeedButton;
- chrmAppCentre: TChromium;
- spblock: TRealICQSpeedButton;
- procedure SysMsgIconClick(Sender: TObject);
- procedure TimerForreconnectgroupTimer(Sender: TObject);
- procedure spbExportGroupUserClick(Sender: TObject);
- procedure btn_unlockClick(Sender: TObject);
- procedure btn_lockClick(Sender: TObject);
- procedure WebBrowserForPostWorkOrderDocumentComplete(ASender: TObject; const pDisp: IDispatch; var URL: OleVariant);
- //procedure spb360SDClick(Sender: TObject);
- procedure miSendTeamSMSClick(Sender: TObject);
- procedure spbWinMeetClick(Sender: TObject);
- procedure RealICQClientGettedSendOfflineFileRequest(Sender: TObject; ALoginName: string; AOppositeID: Cardinal);
- //procedure spb360SafeClick(Sender: TObject);
- procedure RealICQClientGettedPermission(Sender: TObject);
- procedure miMuteClick(Sender: TObject);
- procedure miBusyClick(Sender: TObject);
- procedure miLeaveClick(Sender: TObject);
- procedure imgHeadImageBorderMouseLeave(Sender: TObject);
- procedure imgHeadImageBorderMouseEnter(Sender: TObject);
- procedure pnlToolBarResize(Sender: TObject);
- procedure TimerForShowUserCardTimer(Sender: TObject);
- procedure TimerForHideUserCardTimer(Sender: TObject);
- procedure spbNetworkBackupClick(Sender: TObject);
- procedure tsContactersResize(Sender: TObject);
- procedure tsContactersShow(Sender: TObject);
- procedure RealICQClientReceivedVideoImage(Sender: TObject; ALoginName: string; ABitmap: TBitmap);
- procedure spbRefreshBranchUsersClick(Sender: TObject);
- procedure RealICQClientChangePasswordResult(Sender: TObject; APassChanged: Boolean; ANewPassword: string);
- procedure RealICQClientGetDBProcedureResult(Sender: TObject; DBProcedureName, ArgIn, ArgOut: string);
- procedure miGoSpaceClick(Sender: TObject);
- procedure miSetRemarkClick(Sender: TObject);
- procedure btShowMiniPageClick(Sender: TObject);
- procedure RealICQClientGettedMiniPageSets(Sender: TObject);
- procedure spbShowNotReadMessageClick(Sender: TObject);
- procedure lblLogsClick(Sender: TObject);
- procedure TimerForShowSystemNoticesTimer(Sender: TObject);
- procedure lblLogsMouseLeave(Sender: TObject);
- procedure lblLogsMouseEnter(Sender: TObject);
- procedure btNextLogClick(Sender: TObject);
- procedure btPrevLogClick(Sender: TObject);
- procedure RealICQClientGetSystemNoticesCount(Sender: TObject; iCount: Integer; NoticesRecords: array of TSystemNotices);
- procedure RealICQClientGetNotReadMessageCount(Sender: TObject; iCount: Integer);
- procedure TimerForGetBranchUsersOnlineStatesTimer(Sender: TObject);
- procedure TimerForGetBranchOnlineStatesTimer(Sender: TObject);
- procedure TrayIconMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
- procedure RealICQClientGettedRemoteControlTransmiteControlRequest(Sender: TObject; ALoginName: string);
- procedure LblHintClick(Sender: TObject);
- procedure btCloseTopMessageClick(Sender: TObject);
- procedure spbImportGroupUserClick(Sender: TObject);
- procedure miPasteClick(Sender: TObject);
- procedure miCutClick(Sender: TObject);
- procedure miDelGroupUserClick(Sender: TObject);
- procedure miUpdateGroupUserClick(Sender: TObject);
- procedure miAddGroupUserClick(Sender: TObject);
- procedure miDelGroupClick(Sender: TObject);
- procedure miUpdateGroupClick(Sender: TObject);
- procedure miAddGroupClick(Sender: TObject);
- procedure ppAddrBookListPopup(Sender: TObject);
- procedure ppAddrBookListGetControlClass(Sender: TCustomActionBar; AnItem: TActionClient; var ControlClass: TCustomActionControlClass);
- procedure RealICQClientGettedSendFolderRequest(Sender: TObject; AID, ACount: Cardinal; ALoginName: string; AFilesStream: TStream);
- procedure RealICQClientCanceledSendFolder(Sender: TObject; AID: Cardinal; ALoginName: string);
- procedure RealICQClientGettedBranchUser(Sender: TObject);
- procedure ppSelCallTelGetControlClass(Sender: TCustomActionBar; AnItem: TActionClient; var ControlClass: TCustomActionControlClass);
- procedure tsCustomerServiceContextPopup(Sender: TObject; MousePos: TPoint; var Handled: Boolean);
- procedure RealICQClientSearchUserResult(Sender: TObject);
- procedure edtSearchMoreUserChange(Sender: TObject);
- procedure edtSearchMoreUserExit(Sender: TObject);
- procedure edtSearchMoreUserClick(Sender: TObject);
- procedure RealICQClientGettedWebUrl(Sender: TObject);
- procedure RealICQClientReceivedServerList(Sender: TObject; AServerList: string);
- procedure spbSelectServerClick(Sender: TObject);
- procedure MeasureItem(Sender: TObject; ACanvas: TCanvas; var Width, Height: Integer);
- procedure ppServerListGetControlClass(Sender: TCustomActionBar; AnItem: TActionClient; var ControlClass: TCustomActionControlClass);
- procedure RealICQClientGettedMoreUserList(Sender: TObject);
- procedure RealICQClientGettedMoreBranchList(Sender: TObject);
- procedure ppChangeCustomerStateGetControlClass(Sender: TCustomActionBar; AnItem: TActionClient; var ControlClass: TCustomActionControlClass);
- procedure btCustomerDisplayNameClick(Sender: TObject);
- procedure spbPersonManageClick(Sender: TObject);
- procedure edFilterKeywordClick(Sender: TObject);
- procedure ImageButtonEnter(Sender: TObject);
- procedure ImageButtonLeave(Sender: TObject);
- procedure ImageButtonMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
- procedure pgcMainWorkAreaWebPanelButtonClick(Sender: TObject);
- procedure ppMainMenuGetControlClass(Sender: TCustomActionBar; AnItem: TActionClient; var ControlClass: TCustomActionControlClass);
- procedure btMainMenuClick(Sender: TObject);
- procedure tsAddrBookShow(Sender: TObject);
- procedure WebBrowserAddrBookDocumentComplete(ASender: TObject; const pDisp: IDispatch; var URL: OleVariant);
- procedure WebBrowserAddrBookBeforeNavigate2(ASender: TObject; const pDisp: IDispatch; var URL, Flags, TargetFrameName, PostData, Headers: OleVariant; var Cancel: WordBool);
- procedure RealICQClientGettedCancelRemoteControlTransmite(Sender: TObject; ALoginName: string);
- procedure RealICQClientCancelControlRemoteControlTransmite(Sender: TObject; ALoginName: string);
- procedure RealICQClientSendedRemoteControlTransmiteRequest(Sender: TObject; ALoginName: string);
- procedure RealICQClientSendedRemoteControlTransmiteControlRequest(Sender: TObject; ALoginName: string);
- procedure RealICQClientGettedStopRemoteControlTransmite(Sender: TObject; ALoginName: string; AIsStopper: Boolean);
- procedure RealICQClientGettedRemoteControlTransmiteScreenSize(Sender: TObject; ALoginName: string; AWidth, AHeight: Integer);
- procedure RealICQClientGettedRemoteControlTransmiteScreenImage(Sender: TObject; ALoginName: string; ALeft, ATop, AWidth, AHeight: Integer; AP: TPoint; ABitmap: TBitmap);
- procedure RealICQClientGettedRemoteControlTransmiteResponse(Sender: TObject; ALoginName: string; AAcceptted: Boolean);
- procedure RealICQClientGettedRemoteControlTransmiteRequest(Sender: TObject; ALoginName: string);
- procedure RealICQClientGettedRemoteControlTransmiteControlResponse(Sender: TObject; ALoginName: string; AAcceptted: Boolean);
- procedure RealICQClientGettedRemoteControlTransmiteConnectted(Sender: TObject; ALoginName: string);
- procedure RealICQClientGettedRemoteControlTransmiteBeControlResponse(Sender: TObject; ALoginName: string; AAcceptted: Boolean);
- procedure RealICQClientReceivedOfflineFile(Sender: TObject; ASender, AFileName: string; AFileSize: Int64; ASendDateTime: TDateTime);
- procedure TimerForLoginingTimer(Sender: TObject);
- procedure TimerForCheckLogoutTimeoutTimer(Sender: TObject);
- procedure actShowRemarkExecute(Sender: TObject);
- procedure actChangeRemarkExecute(Sender: TObject);
- procedure actHelpExecute(Sender: TObject);
- procedure actAboutExecute(Sender: TObject);
- procedure lblReConnectClick(Sender: TObject);
- procedure spbAutoLoginClick(Sender: TObject);
- procedure spbSavePasswordClick(Sender: TObject);
- procedure miOtherStateClick(Sender: TObject);
- procedure miMeetingClick(Sender: TObject);
- procedure miHiddenClick(Sender: TObject);
- procedure miOnlineClick(Sender: TObject);
- procedure ppLoginStatesGetControlClass(Sender: TCustomActionBar; AnItem: TActionClient; var ControlClass: TCustomActionControlClass);
- procedure ppChangeStatesPopup(Sender: TObject);
- procedure spbLoginStateClick(Sender: TObject);
- procedure miClearLoginHistoryClick(Sender: TObject);
- procedure spbChangeLoginNameClick(Sender: TObject);
- procedure ppLoginedUsersPopup(Sender: TObject);
- procedure ppLoginedUsersGetControlClass(Sender: TCustomActionBar; AnItem: TActionClient; var ControlClass: TCustomActionControlClass);
- procedure edLoginNameChange(Sender: TObject);
- procedure lblRegisterMouseLeave(Sender: TObject);
- procedure lblRegisterMouseEnter(Sender: TObject);
- procedure actShowTeamHistoryExecute(Sender: TObject);
- procedure actShowHistoryExecute(Sender: TObject);
- procedure actAVSetExecute(Sender: TObject);
- procedure actMsgManagerExecute(Sender: TObject);
- procedure WebBrowserForAdvertisementBeforeNavigate2(ASender: TObject; const pDisp: IDispatch; var URL, Flags, TargetFrameName, PostData, Headers: OleVariant; var Cancel: WordBool);
- procedure RealICQClientReceivedSystemMessage(Sender: TObject; ASystemMessage: TRealICQSystemMessage);
- procedure TimerForShowSystemMessageTimer(Sender: TObject);
- procedure RealICQClientReceivedAdversement(Sender: TObject);
- procedure WebBrowserForAdvertisementDocumentComplete(ASender: TObject; const pDisp: IDispatch; var URL: OleVariant);
- procedure RealICQClientDownloadTeamFace(Sender: TObject; AFileName: string);
- procedure RealICQClientPleaseUploadTeamFace(Sender: TObject; MD5String: string; var FileName: string);
- procedure RealICQClientReceivedTeamMessage(Sender: TObject; RealICQTeamMessage: TRealICQTeamMessage);
- procedure RealICQClientSendTeamMessageFailed(Sender: TObject; RealICQTeamMessage: TRealICQTeamMessage);
- procedure RealICQClientSendedTeamMessage(Sender: TObject; RealICQTeamMessage: TRealICQTeamMessage);
- procedure RealICQClientJoinTeamResponse(Sender: TObject; ATeamID: string; ALoginName: string; ATag: string; AAcceptted: Boolean);
- procedure RealICQClientJoinTeamRequest(Sender: TObject; ARealICQTeam: TRealICQTeam; ALoginName, ATag: string);
- procedure spbFindTeamClick(Sender: TObject);
- procedure RealICQClientTeamQuitted(Sender: TObject; ARealICQTeam: TRealICQTeam; ALoginName: string);
- procedure RealICQClientTeamDisbanded(Sender: TObject; ARealICQTeam: TRealICQTeam);
- procedure actQuitOrDisbandTeamsExecute(Sender: TObject);
- procedure ppTeamListViewPopup(Sender: TObject);
- procedure ppTeamListViewGetControlClass(Sender: TCustomActionBar; AnItem: TActionClient; var ControlClass: TCustomActionControlClass);
- procedure actDisbandTeamExecute(Sender: TObject);
- procedure actQuitTeamExecute(Sender: TObject);
- procedure actSeeTeamInformationExecute(Sender: TObject);
- procedure actSendTeamMessageExecute(Sender: TObject);
- procedure RealICQClientJoinedTeam(Sender: TObject; ARealICQTeam: TRealICQTeam);
- procedure RealICQClientTeamInfoReady(Sender: TObject; ARealICQTeam: TRealICQTeam);
- procedure actCreateTeamExecute(Sender: TObject);
- procedure RealICQClientGettedCancelVideoTransmite(Sender: TObject; ALoginName: string);
- procedure RealICQClientGettedStopVideoTransmite(Sender: TObject; ALoginName: string; AIsStopper: Boolean);
- procedure RealICQClientSendedVideoTransmiteRequest(Sender: TObject; ALoginName: string);
- procedure RealICQClientGettedVideoTransmiteResponse(Sender: TObject; ALoginName: string; AAcceptted: Boolean);
- procedure RealICQClientGettedVideoTransmiteRequest(Sender: TObject; ALoginName: string);
- procedure RealICQClientGettedVideoTransmiteConnectted(Sender: TObject; ALoginName: string; ASendBigBmp, ARecvBigBmp: Boolean);
- procedure RealICQClientGettedAudioTransmiteConnectted(Sender: TObject; ALoginName: string);
- procedure RealICQClientGettedStopAudioTransmite(Sender: TObject; ALoginName: string; AIsStopper: Boolean);
- procedure RealICQClientGettedCancelAudioTransmite(Sender: TObject; ALoginName: string);
- procedure RealICQClientGettedAudioTransmiteResponse(Sender: TObject; ALoginName: string; AAcceptted: Boolean);
- procedure RealICQClientGettedAudioTransmiteRequest(Sender: TObject; ALoginName: string);
- procedure RealICQClientSendedAudioTransmiteRequest(Sender: TObject; ALoginName: string);
- procedure RealICQClientInputting(Sender: TObject; ALoginName: string; AInputting: Boolean);
- procedure actOpenRecvFileDirExecute(Sender: TObject);
- procedure actCustomFacesManagerExecute(Sender: TObject);
- procedure RealICQClientPleaseSendFaceToMe(Sender: TObject; ALoginName, AFaceMD5Code: string);
- procedure RealICQClientCancelSendFile(Sender: TObject; ALoginName: string; AOppositeID: Cardinal);
- procedure RealICQClientSendedSendFileRequest(Sender, FileTransmitter: TObject);
- procedure RealICQClientGettedSendFileRequest(Sender: TObject; SendFileRequestInfo: TSendFileRequestInfo);
- procedure ApplicationEventsException(Sender: TObject; E: Exception);
- procedure RealICQClientDisconnected(Sender: TObject);
- procedure TimerForFlashTrayIconTimer(Sender: TObject);
- procedure RealICQClientReceivedMessage(Sender: TObject; RealICQMessage: TRealICQMessage);
- procedure RealICQClientSendMessageFailed(Sender: TObject; RealICQMessage: TRealICQMessage);
- procedure FormShow(Sender: TObject);
- procedure actShowGIFInTalkingFormExecute(Sender: TObject);
- procedure actShowGIFInMailFormExecute(Sender: TObject);
- procedure RealICQClientUserExInformationChanged(Sender: TObject; RealICQUser: TRealICQUser);
- procedure actSendMessageExecute(Sender: TObject);
- procedure RealICQClientDownloadFile(Sender: TObject; AFileName: string);
- procedure RealICQClientGetWebTabs(Sender: TObject; ATabCount: Integer; WebTabRecords: array of TWebTabRecord);
- procedure spbCancelFilterClick(Sender: TObject);
- procedure edFilterKeywordChange(Sender: TObject);
- procedure edFilterKeywordExit(Sender: TObject);
- procedure actSeeInformationExecute(Sender: TObject);
- procedure ppColorsPopup(Sender: TObject);
- procedure miMoreColorsClick(Sender: TObject);
- procedure ppColorsGetControlClass(Sender: TCustomActionBar; AnItem: TActionClient; var ControlClass: TCustomActionControlClass);
- procedure TrayIconMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
- procedure actCloseExecute(Sender: TObject);
- procedure TrayIconClick(Sender: TObject);
- procedure TimerForCheckDblClickTimer(Sender: TObject);
- procedure ppTrayIconGetControlClass(Sender: TCustomActionBar; AnItem: TActionClient; var ControlClass: TCustomActionControlClass);
- procedure TrayIconDblClick(Sender: TObject);
- procedure actOpenMainFormExecute(Sender: TObject);
- procedure actQuitExecute(Sender: TObject);
- procedure FormResize(Sender: TObject);
- procedure ppChangeStatesGetControlClass(Sender: TCustomActionBar; AnItem: TActionClient; var ControlClass: TCustomActionControlClass);
- procedure spbDisplayNameClick(Sender: TObject);
- procedure actAlwaysOnTopExecute(Sender: TObject);
- procedure actShowTeamsExecute(Sender: TObject);
- procedure actShowBlacklistsExecute(Sender: TObject);
- procedure actShowStrangersExecute(Sender: TObject);
- procedure actRemoveUserExecute(Sender: TObject);
- procedure RealICQClientAddedBlacklists(Sender: TObject; ALoginName: string);
- procedure RealICQClientGettedBlacklists(Sender: TObject);
- procedure actGroupManagerExecute(Sender: TObject);
- procedure actShowMiddleHeadImageExecute(Sender: TObject);
- procedure actShowGroupExecute(Sender: TObject);
- procedure RealICQClientRemovedUser(Sender: TObject; ALoginName: string);
- procedure ppUserItemRightMenuPopup(Sender: TObject);
- procedure ppUserItemRightMenuGetControlClass(Sender: TCustomActionBar; AnItem: TActionClient; var ControlClass: TCustomActionControlClass);
- procedure actDelFriendExecute(Sender: TObject);
- procedure RealICQClientReConnectExecute(Sender: TObject; ASeconds: Integer);
- procedure btLoginClick(Sender: TObject);
- procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
- procedure spbSelUIColorClick(Sender: TObject);
- procedure FormDestroy(Sender: TObject);
- procedure FormCreate(Sender: TObject);
- procedure RealICQClientLoginResult(Sender: TObject; LoginResultType: TRealICQLoginResultType; ResultMessage: string);
- procedure actLoginExecute(Sender: TObject);
- procedure actLogoutExecute(Sender: TObject);
- procedure actLoginAsExecute(Sender: TObject);
- procedure RealICQClientLoginStateChanged(Sender: TObject);
- procedure FormClose(Sender: TObject; var Action: TCloseAction);
- procedure RealICQClientGettedFriendList(Sender: TObject);
- procedure RealICQClientUserInformationReady(Sender: TObject; RealICQUser: TRealICQUser);
- procedure actOnlineExecute(Sender: TObject);
- procedure actHiddenExecute(Sender: TObject);
- procedure actLeaveExecute(Sender: TObject);
- procedure actOtherStateExecute(Sender: TObject);
- procedure RealICQClientBeDropped(Sender: TObject; Excuse: string);
- procedure RealICQClientLoginFailed(Sender: TObject; E: Exception);
- procedure actRegExecute(Sender: TObject);
- procedure actShowLoginNameExecute(Sender: TObject);
- procedure actShowDisplayNameExecute(Sender: TObject);
- procedure actShowAllNameExecute(Sender: TObject);
- procedure actShowBigHeadImageExecute(Sender: TObject);
- procedure actShowSmallHeadImageExecute(Sender: TObject);
- procedure actShowNormalHeadImageExecute(Sender: TObject);
- procedure actFindUsersExecute(Sender: TObject);
- procedure RealICQClientAddFriendRequest(Sender: TObject; ALoginName, ATag: string);
- procedure RealICQClientAddFriendResponse(Sender: TObject; ALoginName, ATag: string; AAcceptted: Boolean);
- procedure actOptionsExecute(Sender: TObject);
- procedure actPersonalSetExecute(Sender: TObject);
- procedure actConnectSetExecute(Sender: TObject);
- procedure actChangePassExecute(Sender: TObject);
- procedure actShowTreeExecute(Sender: TObject);
- procedure edWebSearchKeyWordEnter(Sender: TObject);
- procedure edWebSearchKeyWordExit(Sender: TObject);
- procedure spbWebSearchClick(Sender: TObject);
- procedure edWebSearchKeyWordKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
- procedure RealICQClientShakeWindow(Sender: TObject; ALoginName: string);
- procedure ppContacterViewStyleGetControlClass(Sender: TCustomActionBar; AnItem: TActionClient; var ControlClass: TCustomActionControlClass);
- procedure spbContacterViewStyleClick(Sender: TObject);
- procedure spbWatchwordClick(Sender: TObject);
- procedure edWatchwordExit(Sender: TObject);
- procedure edWatchwordKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
- procedure ApplicationEventsDeactivate(Sender: TObject);
- procedure ppLanguagesGetControlClass(Sender: TCustomActionBar; AnItem: TActionClient; var ControlClass: TCustomActionControlClass);
- procedure ppLanguagesPopup(Sender: TObject);
- procedure spbSelLanguageClick(Sender: TObject);
- procedure edPasswordEnter(Sender: TObject);
- procedure TimerForHideMainFormTimer(Sender: TObject);
- //procedure TimerForShowMainFormTimer(Sender: TObject);
- procedure FormDeactivate(Sender: TObject);
- procedure sbpSMSClick(Sender: TObject);
- procedure RealICQClientSMSResult(Sender: TObject; AMessageID: Cardinal; AResult: Integer);
- procedure RealICQClientReceivedSMS(Sender: TObject; ASMSSender, ASMSContent: string; ASMSDateTime: TDateTime);
- procedure RealICQClientReceivedCustomMessage(Sender: TObject; AContent: string);
- procedure spbEmailClick(Sender: TObject);
- procedure tsNetWorkDiskShow(Sender: TObject);
- procedure RealICQNetWorkDiskClientConnectStateChanged(Sender: TObject);
- procedure RealICQNetWorkDiskClientLoginFailed(Sender: TObject; E: Exception);
- procedure RealICQNetWorkDiskClientLoginResult(Sender: TObject; LoginResultType: Byte);
- procedure spbNDConnectClick(Sender: TObject);
- procedure RealICQNetWorkDiskClientDirectoryListReady(Sender: TObject);
- procedure spbNDMoveUpClick(Sender: TObject);
- procedure spbNDNewDirClick(Sender: TObject);
- procedure RealICQNetWorkDiskClientNewDirResult(Sender: TObject; Directory: TRealICQNetWorkDiskDirectory);
- procedure ppNetWorkFileGetControlClass(Sender: TCustomActionBar; AnItem: TActionClient; var ControlClass: TCustomActionControlClass);
- procedure ppNetWorkFilePopup(Sender: TObject);
- procedure spbNDDeleteClick(Sender: TObject);
- procedure miNDRenameClick(Sender: TObject);
- procedure RealICQNetWorkDiskClientRenamedDir(Sender: TObject; ADirectory: TRealICQNetWorkDiskDirectory);
- procedure RealICQNetWorkDiskClientRenamedFile(Sender: TObject; AFile: TRealICQNetWorkDiskFile);
- procedure RealICQNetWorkDiskClientDeleteResult(Sender: TObject; AList: string);
- procedure spbNDRefreshClick(Sender: TObject);
- procedure spbNDUploadClick(Sender: TObject);
- procedure RealICQNetWorkDiskClientUploadedFile(Sender: TObject; AFile: TRealICQNetWorkDiskFile; AMissionID: string);
- procedure TabSetNDMissionsChange(Sender: TObject; NewTab: Integer; var AllowChange: Boolean);
- procedure TabSetNDMissionsClick(Sender: TObject);
- procedure RealICQNetWorkDiskClientUploadFileAborted(Sender: TObject; AMissionID: string);
- procedure RealICQNetWorkDiskClientUploadingFile(Sender: TObject; ATransmitter: TResponsionStreamTransmitter; ATransmittedSize: Int64);
- procedure ppNetWorkMissonGetControlClass(Sender: TCustomActionBar; AnItem: TActionClient; var ControlClass: TCustomActionControlClass);
- procedure ppNetWorkMissonPopup(Sender: TObject);
- procedure miNDCancelClick(Sender: TObject);
- procedure RealICQNetWorkDiskClientGettedUsedSpaceSize(Sender: TObject);
- procedure spbNDCancelAllClick(Sender: TObject);
- procedure RealICQNetWorkDiskClientNoSpace(Sender: TObject);
- procedure spbNDDisconnectClick(Sender: TObject);
- procedure RealICQNetWorkDiskClientDownloadFileAborted(Sender: TObject; AFileDownloader: TRealICQNWDFileDownloader);
- procedure RealICQNetWorkDiskClientDownloadFileCompleted(Sender: TObject; AFileDownloader: TRealICQNWDFileDownloader);
- procedure spbNDDownloadClick(Sender: TObject);
- procedure RealICQNetWorkDiskClientDownloadFileTransmitting(Sender: TObject; AFileDownloader: TRealICQNWDFileDownloader);
- procedure pgcMainWorkAreaTabChanging(Sender: TObject; NewIndex: Integer; var AllowChanged: Boolean);
- procedure TabSetMuiltWebClick(Sender: TObject);
- procedure spbShowHideRightClick(Sender: TObject);
- procedure cbxURLInputerDropDown(Sender: TObject);
- procedure spbGoClick(Sender: TObject);
- procedure cbxURLInputerKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
- procedure cbxURLInputerSelect(Sender: TObject);
- procedure spbPrevClick(Sender: TObject);
- procedure spbStopClick(Sender: TObject);
- procedure spbNextClick(Sender: TObject);
- procedure spbRefreshClick(Sender: TObject);
- procedure spbAddToNAClick(Sender: TObject);
- procedure spbPrintPrevClick(Sender: TObject);
- procedure spbWebCloseClick(Sender: TObject);
- procedure sbpNewWebTabClick(Sender: TObject);
- procedure TabSetMuiltWebGetImageIndex(Sender: TObject; TabIndex: Integer; var ImageIndex: Integer);
- procedure ApplicationEventsMessage(var Msg: tagMSG; var Handled: Boolean);
- procedure RealICQClientReceivedOfflineAutoResponseSet(Sender: TObject; AEnabled: Boolean; AText: string);
- procedure actOfflieAutoResponseExecute(Sender: TObject);
- procedure RealICQClientUsersBranchReady(Sender: TObject);
- procedure WebBrowserForContactersBeforeNavigate2(ASender: TObject; const pDisp: IDispatch; var URL, Flags, TargetFrameName, PostData, Headers: OleVariant; var Cancel: WordBool);
- procedure RealICQClientGettedSysMsgInterfaces(Sender: TObject);
- procedure RealICQClientGettedCanSendSMSCount(Sender: TObject);
- // procedure ImgQrCodeClick(Sender: TObject);
- procedure SysMsgClick(Sender: TObject);
- procedure btnCALoginClick(Sender: TObject);
- procedure btOAClick(Sender: TObject);
- procedure btSwapClick(Sender: TObject);
- //procedure TimerForShowHideMainFrmTimer(Sender: TObject);
- private
- FIsLogout: Boolean;
- FLastGetSystemNoticesTicket: Cardinal;
- FSystemNoticeIndex: Integer;
- FSystemNotices: TList;
- FNotAddedEmployeeList: TStringList;
- procedure ShowBranchAndUsers(ExpandSelfNode: Boolean = False);
- procedure ShowBranchAndFriends;
- procedure GetOtherBranchs;
- procedure GetBranchUser(Branch: TRealICQBranch);
- procedure ShowSystemNotices;
- procedure OpenNewWorkDisk(Path: string);
- private
- FFilter: Boolean;
- FKeyList: TStrings;
- FProductType: TRealICQProductType;
- FUserType: TRealICQUserType;
- FCurrentServerID: string;
- FTopSystemMessage: TRealICQSystemMessage;
- FServerInfoList: TStringList;
- FWebPanels: TStringList;
- FAutoHide: Boolean;
- FNewConsole: Boolean;
- FAutoShowRequestMessage: Boolean;
- FMovingMainForm: Boolean;
- FWindowMoveing: Boolean;
- //FDblClickedTrayIcon: Boolean;
- FMainFormHidden: Boolean;
- FHidePosition: THidePosition;
- FConfirmReplaceResult: Integer;
- FLastDownloadDirectory: string;
- FAddrBookURL: string;
- // FPCAMessage:TPCAMessage;
- // FGroupAddress: string;
- // FGroupPort: Integer;
- // FGroupImagePort: Integer;
- // FGroupShareAddress: string;
- // FGroupSharePort: Integer;
- //procedure PostUpdateLog;
- procedure GetWeather(City, Weatheren, Weather: string);
- procedure WMMoving(var Msg: TWMMoving); message WM_MOVING;
- procedure WMSizing(var Msg: TMessage); message WM_SIZING;
- procedure WMSize(var Msg: TMessage); message WM_SIZE;
- procedure WMMove(var Msg: TMessage); message WM_MOVE;
- procedure WMNCMouseMove(var msg: TWMNCMousemove); message WM_NCMOUSEMOVE;
- procedure WindowMove(blnShow: Boolean; iBase: Integer);
- procedure AddUploadMission(AUploadMissionType: TNDMissionType; ADirectoryID: Integer; AName: string; CheckMission: Boolean = True);
- procedure CheckUploadMissions;
- procedure GoNextLevelUploadMissions(UploadMission: TUploadMission);
- procedure CheckNDControlState;
- procedure AddDownloadMission(ADownloadMissionType: TNDMissionType; ADirectoryName: string; AFileID: Integer = 0; AFileName: string = ''; CheckMission: Boolean = True);
- procedure CheckDownloadMissions;
- procedure ShowNetWorkDiskSpaceInfo;
- procedure WebBrowserRightStatusTextChange(ASender: TObject; const Text: WideString);
- procedure WebBrowserRightTitleChange(ASender: TObject; const Text: WideString);
- procedure WebBrowserRightDocumentComplete(ASender: TObject; const pDisp: IDispatch; var URL: OleVariant);
- procedure WebBrowserRightDocumentCompleteForPost(ASender: TObject; const pDisp: IDispatch; var URL: OleVariant);
- procedure WebBrowserRightNewWindow2(ASender: TObject; var ppDisp: IDispatch; var Cancel: WordBool);
- procedure WebBrowserRightWindowClosing(ASender: TObject; IsChildWindow: WordBool; var Cancel: WordBool);
- public
- MessageBoxForm: TMessageBoxForm;
- property WebPanels: TStringList read FWebPanels;
- procedure LoadWebPanelsFromXML;
- procedure SaveWebPanelsToXML;
- procedure ShowWebTabs;
- procedure HideMainForm;
- procedure ShowMainForm;
- function AddWebBrowserToPageControl(AUrl: string; WebPanelTag: Integer = -1): TWebBrowser;
- procedure OpenNotReadMessage(iIndex: Integer);
- procedure SaveBranchUserDataToXML(FileName: string);
- procedure UpdatePostLogState(Status: Boolean);
- procedure ShowOrHideMuiltiWeb;
- private
- //FDownFile: TDownFile;
- {通讯录}
- FCutNode: TTreeNode;
- FManageGroupMsgList: TStringList;
- FManageGroupMemberMsgList: TStringList;
- {通讯录}
- FGetUsersTask: TStringList;
- FHintWindow: TSingleBorderHintWindow;
- ActiveButtonTag: Integer;
- FToolBarButtonList: TStringList;
- FToolBarButtonIconList: TStringList;
- FFriendInfo: TStringList; //存储从好友列表移动到黑名单的好友信息
- FLoginAsSavePassword, FSavePassword, FAutoLogin: Boolean;
- FLoginState: TRealICQLoginState;
- FLeaveMessage: string;
- FCanAlert, FHidden: Boolean;
- FUIMainColor: TColor;
- FShowGroup: Boolean;
- FGroups: TStringList;
- FLVSelectedItemBorderColor: TColor;
- FLVSelectedItemBorderInnerColor: TColor;
- FLVSelectedItemBackColor: TColor;
- FLVHeadImageBorderColor: TColor;
- FLVHeadImageBackColor: TColor;
- FLVStyle: TRealICQContacterListItemStyle;
- FLVCaptionStyle: TRealICQContacterListItemCaptionStyle;
- FShowTree: Boolean; //是否以树型方式组织联系人列表
- FShowStrangers: Boolean;
- FShowBlacklists: Boolean;
- FShowTeams: Boolean;
- FShowLatests: Boolean;
- FShowGIFInMailForm: Boolean;
- FShowGIFInTalkingForm: Boolean;
- FFlashTrayIconIndex: Integer;
- FFlashTrayIconIndexAtLogining: Integer;
- FAlwaysOnTop: Boolean;
- FTalkingFormAlwaysOnTop: Boolean;
- FCtrlEnterSendMessage: Boolean;
- FCopyScreenHideTalkForm: Boolean;
- FReadMessageHotKey: string; // Cardinal;
- FCopyScreenHotKey: string; // Cardinal;
- FMainFormLeft: Integer;
- FMainFormTop: Integer;
- FMainFormWidth: Integer;
- FMainFormHeight: Integer;
- FTalkingFormLeft: Integer;
- FTalkingFormTop: Integer;
- FTalkingFormWidth: Integer;
- FTalkingFormHeight: Integer;
- FTalkingRightWidth: Integer;
- FSMSFormLeft, FSMSFormTop, FSMSFormWidth, FSMSFormHeight: Integer;
- FConfirmSendOfflineFile: Boolean;
- FShowMainFormOnStart: Boolean;
- FCursorPosX: Integer;
- FCursorPosY: Integer;
- FLastDBlClickTicket: Cardinal;
- FNeedShowUserCardLoginName: string;
- FShowUserCardTargetTop: Integer;
- FWebTabs: TList;
- //未处理的系统消息集合
- FSystemMessages: TList;
- FLastSearchKeyWord: string;
- // FLastActiveIndex: Integer;
- FSearchListViewInVisible: Boolean;
- FSearchListView: TRealICQContacterListView;
- FSearchMoreUserListView: TRealICQContacterListView;
- //显示系统消息的ListView
- FLVSystemMessage: TRealICQContacterListView;
- //显示群组列表的ListView
- FLVTeams: TRealICQContacterListView;
- //显示最近联系人列表的ListView
- FLVNetWorkDisk: TRealICQContacterListView;
- FLVNetWorkDiskUploadingFiles: TRealICQContacterListView;
- FLVNetWorkDiskDownloadingFiles: TRealICQContacterListView;
- //客服最近联系列表w
- FTVCustomerLatests: TRealICQContacterTreeView;
- FLVCustomers: TRealICQContacterListView;
- FContacterListViews: TStringList;
- FContacterTreeViews: TStringList;
- FTrayIconRect: TRect;
- FGettedTrayIconRect: Boolean;
- FInputFont: TFont;
- FSystemFaceCount: Integer;
- FFaceList, FTempFaceList, FFaceCategory: TStringList;
- FShowHintOnOnline: Boolean;
- FShowHintOnOffline: Boolean;
- FDontShowHintOnBusy: Boolean;
- FPlaySoundOnOnline: Boolean;
- FPlaySoundOnOffline: Boolean;
- FPlaySoundOnGetMessage: Boolean;
- FPlaySoundOnGetSystemMessage: Boolean;
- FFlashCaptionOnOnline: Boolean;
- FFlashImageOnGetMessage: Boolean;
- FShowShakeWindow: Boolean;
- FShowCustomMessage: Boolean;
- FShowFileTransCompleted: Boolean;
- FOnlineEventSound: string;
- FOfflineEventSound: string;
- FMessageEventSound: string;
- FSystemMessageEventSound: string;
- FRecvFileSafeLevel: TRecvFileSafeLevel;
- FAllowURL: Boolean;
- FAutoSaveMessage: Boolean;
- FShowHistoryInNewWindow: Boolean;
- FAutoUpdate: Boolean;
- FRecvFileDir: string;
- FUseCacheDir: Boolean;
- FCacheDir: string;
- FLimitCacheDirSize: Boolean;
- FMaxCacheDirSize: Integer;
- FAudoDeleteCacheFile: Boolean;
- FAudoDeleteCacheFileDate: Integer;
- FScanVirus: Boolean;
- FScanVirusProgram: string;
- FDontUseCacheFileOnBigFile: Boolean;
- FDontUseCacheFileOnBigFileSize: Integer;
- //读取/保存历史记录的对象
- FDBHistory: TRealICQDBHistory;
- FOfflineAutoResponseTexts: TStringList;
- CLOSEWINDOWS: UINT; //接收别的进程发送的退出程序的消息
- procedure DownFileComplete(Source_file, Dest_file: string; blStatus: boolean; ErrMessage: string);
- procedure DownFaceFileComplete(Source_file, Dest_file: string; blStatus: boolean; ErrMessage: string);
- procedure QuitWindows();
- procedure ShowFriendLists;
- procedure ShowBlacklists;
- procedure CheckCacheDir;
- procedure LoadOfflineAutoResponseSets;
- //读取最近的联系人列表
- procedure LoadLatests;
- procedure AddMessageHistory(ASystemMessageType: TSystemMessageType; ASimpleMessage: string; ASystemMessage: TRealICQSystemMessage);
- function GetSelectedLoginName: string;
- procedure SetTalkingFormAlwaysOnTop(Value: Boolean);
- procedure SetCtrlEnterSendMessage(Value: Boolean);
- procedure SetCopyScreenHideTalkForm(Value: Boolean);
- procedure SetSearchListViewVisible(AShow: Boolean);
- procedure SetUIState;
- procedure SetLoginControlsVisible(Value: Boolean);
- procedure SetLoginStateControlState;
- procedure LoadMainTabImage;
- procedure LoadHintAndSoundConfigs;
- procedure LoadReceiveFileConfigs;
- procedure LoadSafeConfigs;
- procedure LoadGroupConfigs;
- procedure SaveIfShowGroupConfig;
- procedure ShowGroupInterface;
- procedure LoadStyleConfigs;
- procedure SaveStyleConfigs;
- procedure LoadHotKeyConfigs;
- procedure SaveHotKeyConfigs;
- procedure SetReadMessageHotKey(Value: string);
- procedure SetCopyScreenHotKey(Value: string);
- procedure LoadDefaultConfigs;
- procedure LoadAutoUpdateConfigs;
- procedure LoadInputConfigs;
- procedure SaveInputFontConfig;
- //procedure LoadGroupConfig;
- function GetSystemMessageCounter(AMessageID: Integer): Integer;
- procedure IncSystemMessageCounter(AMessageID: Integer);
- procedure SetInputFont(Value: TFont);
- procedure SetShowGroup(Value: Boolean);
- function GetListViewByLoginName(ALoginName: string; AOnlyInGroups: Boolean = False): TRealICQContacterListView;
- procedure SetFlashCaptionOnOnlineValue(Value: Boolean);
- procedure SetLoginStateMenuChecked;
- procedure SetStyleMenuChecked;
- procedure miChangeLoginNameClick(Sender: TObject);
- procedure miChangeServerClick(Sender: TObject);
- procedure miMoveGroupClick(Sender: TObject);
- procedure miMoveToBlacklistsClick(Sender: TObject);
- procedure miMoveToStrangersClick(Sender: TObject);
- procedure ItemShowHint(Sender: TObject; Item: TRealICQContacterListItem; var HintStr: string);
- procedure NDItemDoubleClick(Item: TRealICQContacterListItem);
- procedure NDSelectItemChanged(Item: TRealICQContacterListItem);
- procedure NDMissionItemIconButtonClick(Sender: TObject; Item: TRealICQContacterListItem; IconButtonType: TRealICQContacterListItemIconButtonType);
- procedure NDMissionDropFiles(Sender: TObject; var Message: TMessage);
- procedure NDItemMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
- procedure NodeBranchClick(Sender: TObject; Branch: TRealICQBranch);
- procedure NodeOnline(Employee: TRealICQEmployee);
- procedure NodeOffline(Employee: TRealICQEmployee);
- procedure NodeDoubleClick(Employee: TRealICQEmployee);
- procedure NodeIconButtonClick(Sender: TObject; Employee: TRealICQEmployee; IconButtonType: TRealICQContacterTreeNodeIconButtonType);
- procedure NodeIconButtonDblClick(Sender: TObject; Employee: TRealICQEmployee; IconButtonType: TRealICQContacterTreeNodeIconButtonType);
- procedure NodeOnMouseEnter(Employee: TRealICQEmployee);
- procedure NodeOnMouseLeave(Employee: TRealICQEmployee);
- {通讯录}
- procedure NodeGroupClick(Sender: TObject; Group: TRealICQBranch);
- procedure GetChildsGroupId(GroupId: string; var Groups: string);
- procedure GettedAddrBookUsers(Sender: TObject);
- procedure GettedAddrBookUsers1(Sender: TObject);
- procedure GettedAddrBookGroups(Sender: TObject);
- procedure LoadAddrBook(ExpandGroupId: string);
- procedure GettedManageAddrBookResult(Sender: TObject; OperatModal: Integer; OperatCommand: Integer; RetValue, MessageId: Cardinal);
- function GetGroupUsers(GroupId: string): Integer;
- function GetAddrBookUserIndex(GroupId, LoginName: string): Integer;
- function GetAddrBookUser(GroupId, LoginName: string): TRealICQUser;
- {通讯录}
- procedure miSkinClick(Sender: TObject);
- procedure miColorClick(Sender: TObject);
- procedure WebTabShow(Sender: TObject);
- procedure miLanguageClick(Sender: TObject);
- private
- FCheckedUpdate: Boolean;
- TabAcountIndex: Integer;
- FNotReadMessages: TStringList; {未读消息}
- HotKeyID_ReadMessage: Integer;
- HotKeyID_CopyScreen: Integer;
- procedure WMHotKeyHandle(var Msg: TWMHotKey); message WM_HotKey;
- procedure ShowRealICQMessage(RealICQMessage: TRealICQMessage; ShowSendFailed: Boolean; ARealICQClient: TRealICQClient);
- procedure ShowSystemMessage(ASystemMessage: TRealICQSystemMessage);
- procedure SetShowMainFormOnStart(Value: Boolean);
- procedure SaveWindowState;
- function GetBitmapFromFileExt(AFileName: string): string;
- protected
- procedure ChangeLanguage(ALanguageIniFile: string); override;
- procedure Post(stURL, stPostData: string; var wbWebBrowser: TWebBrowser);
- procedure WMQueryEndSession(var message: TWMQUERYENDSESSION); message WM_QUERYENDSESSION;
- procedure WMPowerBroadcast(var message: TMessage); message WM_POWERBROADCAST;
- procedure CMWininichange(var Message: TWMWinIniChange); message CM_WININICHANGE;
- procedure WndProc(var Message: TMessage); override;
- procedure CreateParams(var Params: TCreateParams); override;
- public
- FLVLatests: TRealICQContacterListView;
- constructor Create(AOwner: TComponent); override;
- procedure ChangeUIColor(AColor: TColor); override;
- procedure ChangePPMenuColorMap(PopupMenuEx: TCustomActionPopupMenuEx);
- procedure NodeOnHeadImageMouseEnter(Employee: TRealICQEmployee);
- procedure NodeOnHeadImageMouseLeave(Employee: TRealICQEmployee);
- procedure ShowMeInformation;
- procedure ShowUserCardForm(ALoginName: string; ATargetTop: Integer);
- procedure HideUserCardForm;
- procedure UpdateAddrBookInfo(RealICQUser: TRealICQUser);
- //function GetDefaultBrowser: string; //获取默认浏览器
- procedure ShowRealICQTeamMessage(RealICQTeamMessage: TRealICQTeamMessage; ShowSendFailed: Boolean);
- procedure WebSocketRemoveTeamResponse(aTeamID: string);
- procedure WebSocketQuitTeam(aTeamID: string);
- procedure WebSocketSendReadTeamInfo(aTeamID: string);
- procedure WebSocketRecivedbroadcastmesssage(aID, aGroupID, aSayer, aStyle, aMsg: string; aTimesTamp: TDateTime);
- procedure WebSocketJionTeamRequest(TeamID, ALoginName, ATag: string);
- procedure DownLoadUpdateConfig;
- procedure OpenWebTab(TabSheet: TTabSheet; WebPanel: TWebPanel; AcountIndex: Integer);
- procedure UploadWebTabAccounts;
- procedure GetBranchEmpOnlineAndSum(Branchs: TStringList; BranchInfo: TRealICQBranchInfo; var OnlineEmployee, EmployeeCount: Integer);
- function GetBranchName(LoginName: string): string;
- function GetCompany: string;
- procedure StopHeadImageFlash(AID: string);
- {通讯录}
- function GetGroupUserCount: Integer;
- procedure SaveContacter(Name, Mobile, Tel, Email, Remark, BranchId: string);
- procedure GetParentGroupNameList(BranchInfo: TRealICQBranchInfo; var Groups: string);
- procedure CreateManageGroupMessage(GroupId, GroupName, ParentId, MessageId: string);
- procedure CreateManageGroupMemberMessage(ID, DisplayName, NickName, Mobile, Tel, Email, Remark, GroupId, MessageId: string);
- {通讯录}
- procedure ItemOnline(Item: TRealICQContacterListItem);
- procedure ItemOffline(Item: TRealICQContacterListItem);
- procedure ItemDoubleClick(Item: TRealICQContacterListItem);
- procedure ItemIconButtonClick(Sender: TObject; Item: TRealICQContacterListItem; IconButtonType: TRealICQContacterListItemIconButtonType);
- procedure ItemIconButtonDblClick(Sender: TObject; Item: TRealICQContacterListItem; IconButtonType: TRealICQContacterListItemIconButtonType);
- procedure ItemOnMouseEnter(Item: TRealICQContacterListItem);
- procedure ItemOnMouseLeave(Item: TRealICQContacterListItem);
- procedure ItemOnHeadImageEnter(Item: TRealICQContacterListItem);
- procedure ItemOnHeadImageLeave(Item: TRealICQContacterListItem);
- procedure SetToolBarState(Sender: TObject);
- function GetActiveTabSheetName: string;
- function AddFriendTreeView(AOwner: TWinControl; GroupName: string): Integer;
- function AddContacterListView(AOwner: TWinControl; GroupName: string): Integer;
- function AddContacterTreeView(AOwner: TWinControl; GroupName: string): Integer;
- procedure UpdateContacterListView(RealICQContacterListView: TRealICQContacterListView);
- procedure CheckWindowPositon;
- //procedure BindUserDataToItem(RealICQContacterListItem: TRealICQContacterListItem; RealICQUser: TRealICQUser; ANeedFlash: Boolean = True);
- //procedure BindUserDataToItemForGroup(RealICQContacterListItem: TRealICQContacterListItem; RealICQUser: TRealICQUser; AGroupAlias: string; ANeedFlash: Boolean = True);
- //procedure UpdateEmployeeNode(Employee: TRealICQEmployee; RealICQUser: TRealICQUser; ANeedFlash: Boolean);
- //procedure UpdateFriendNode(Friend: TRealICQEmployee; RealICQUser: TRealICQUser; ANeedFlash: Boolean);
- procedure StopFlash(ALoginName: string);
- procedure StopFlashTeam(ATeamID: string);
- procedure SetGetMoreUserEvent;
- procedure SaveDefaultConfigs;
- // procedure LoadSysMsgInterfaceConfig;
- // procedure SaveSysMsgInterfaceConfig;
-
property ProductType: TRealICQProductType read FProductType write FProductType;
-
property UserType: TRealICQUserType read FUserType write FUserType;
-
property Filter: Boolean read FFilter write FFilter;
-
property KeyList: TStrings read FKeyList write FKeyList;
- procedure SaveGroupConfigs;
- procedure SaveHintAndSoundConfigs;
- procedure SaveCustomFaceConfig;
- procedure SaveReceiveFileConfigs;
- procedure SaveSafeConfigs;
- procedure SaveAutoUpdateConfigs;
- procedure SaveOfflineAutoResponseSets;
- procedure SetDOMStyle(Doc: IHTMLDocument2);
- procedure OpenMessagesManagerForm;
- property ServerInfoList: TStringList read FServerInfoList write FServerInfoList;
- property ContacterListViews: TStringList read FContacterListViews;
- property ContacterTreeViews: TStringList read FContacterTreeViews;
- property ListViewLatests: TRealICQContacterListView read FLVLatests;
- property CurrentServerID: string read FCurrentServerID;
- property UIMainColor: TColor read FUIMainColor;
- property CanAlert: Boolean read FCanAlert;
- property OfflineAutoResponseTexts: TStringList read FOfflineAutoResponseTexts write FOfflineAutoResponseTexts;
- property ShowGroup: Boolean read FShowGroup write SetShowGroup;
- property Groups: TStringList read FGroups write FGroups;
- property TalkingFormAlwaysOnTop: Boolean read FTalkingFormAlwaysOnTop write SetTalkingFormAlwaysOnTop;
- property CtrlEnterSendMessage: Boolean read FCtrlEnterSendMessage write SetCtrlEnterSendMessage;
- property CopyScreenHideTalkForm: Boolean read FCopyScreenHideTalkForm write SetCopyScreenHideTalkForm;
- property InputFont: TFont read FInputFont write SetInputFont;
- property FaceList: TStringList read FFaceList;
- property TempFaceList: TStringList read FTempFaceList;
- property FaceCategory: TStringList read FFaceCategory;
- property SystemFaceCount: Integer read FSystemFaceCount;
- property ShowGIFInMailForm: Boolean read FShowGIFInMailForm;
- property ShowGIFInTalkingForm: Boolean read FShowGIFInTalkingForm;
- property NotReadMessages: TStringList read FNotReadMessages;
- property TalkingFormLeft: Integer read FTalkingFormLeft write FTalkingFormLeft;
- property TalkingFormTop: Integer read FTalkingFormTop write FTalkingFormTop;
- property TalkingFormWidth: Integer read FTalkingFormWidth write FTalkingFormWidth;
- property TalkingFormHeight: Integer read FTalkingFormHeight write FTalkingFormHeight;
- property TalkingRightWidth: Integer read FTalkingRightWidth write FTalkingRightWidth;
- property SMSFormLeft: Integer read FSMSFormLeft write FSMSFormLeft;
- property SMSFormTop: Integer read FSMSFormTop write FSMSFormTop;
- property SMSFormWidth: Integer read FSMSFormWidth write FSMSFormWidth;
- property SMSFormHeight: Integer read FSMSFormHeight write FSMSFormHeight;
- property ShowMainFormOnStart: Boolean read FShowMainFormOnStart write SetShowMainFormOnStart;
- property ConfirmSendOfflineFile: Boolean read FConfirmSendOfflineFile write FConfirmSendOfflineFile;
- property AlwaysOnTop: Boolean read FAlwaysOnTop write FAlwaysOnTop;
- property AutoHide: Boolean read FAutoHide write FAutoHide;
- property AutoShowRequestMessage: Boolean read FAutoShowRequestMessage write FAutoShowRequestMessage;
- property ShowHintOnOnline: Boolean read FShowHintOnOnline write FShowHintOnOnline;
- property ShowHintOnOffline: Boolean read FShowHintOnOffline write FShowHintOnOffline;
- property DontShowHintOnBusy: Boolean read FDontShowHintOnBusy write FDontShowHintOnBusy;
- property PlaySoundOnOnline: Boolean read FPlaySoundOnOnline write FPlaySoundOnOnline;
- property PlaySoundOnOffline: Boolean read FPlaySoundOnOffline write FPlaySoundOnOffline;
- property PlaySoundOnGetMessage: Boolean read FPlaySoundOnGetMessage write FPlaySoundOnGetMessage;
- property PlaySoundOnGetSystemMessage: Boolean read FPlaySoundOnGetSystemMessage write FPlaySoundOnGetSystemMessage;
- property FlashCaptionOnOnline: Boolean read FFlashCaptionOnOnline write FFlashCaptionOnOnline;
- property FlashImageOnGetMessage: Boolean read FFlashImageOnGetMessage write FFlashImageOnGetMessage;
- property ShowShakeWindow: Boolean read FShowShakeWindow write FShowShakeWindow;
- property ShowCustomMessage: Boolean read FShowCustomMessage write FShowCustomMessage;
- property ShowFileTransCompleted: Boolean read FShowFileTransCompleted write FShowFileTransCompleted;
- property OnlineEventSound: string read FOnlineEventSound write FOnlineEventSound;
- property OfflineEventSound: string read FOfflineEventSound write FOfflineEventSound;
- property MessageEventSound: string read FMessageEventSound write FMessageEventSound;
- property SystemMessageEventSound: string read FSystemMessageEventSound write FSystemMessageEventSound;
- property RecvFileDir: string read FRecvFileDir write FRecvFileDir;
- property UseCacheDir: Boolean read FUseCacheDir write FUseCacheDir;
- property CacheDir: string read FCacheDir write FCacheDir;
- property LimitCacheDirSize: Boolean read FLimitCacheDirSize write FLimitCacheDirSize;
- property MaxCacheDirSize: Integer read FMaxCacheDirSize write FMaxCacheDirSize;
- property AudoDeleteCacheFile: Boolean read FAudoDeleteCacheFile write FAudoDeleteCacheFile;
- property AudoDeleteCacheFileDate: Integer read FAudoDeleteCacheFileDate write FAudoDeleteCacheFileDate;
- property ScanVirus: Boolean read FScanVirus write FScanVirus;
- property ScanVirusProgram: string read FScanVirusProgram write FScanVirusProgram;
- property DontUseCacheFileOnBigFile: Boolean read FDontUseCacheFileOnBigFile write FDontUseCacheFileOnBigFile;
- property DontUseCacheFileOnBigFileSize: Integer read FDontUseCacheFileOnBigFileSize write FDontUseCacheFileOnBigFileSize;
- property RecvFileSafeLevel: TRecvFileSafeLevel read FRecvFileSafeLevel write FRecvFileSafeLevel;
- property AllowURL: Boolean read FAllowURL write FAllowURL;
- property AutoSaveMessage: Boolean read FAutoSaveMessage write FAutoSaveMessage;
- property ShowHistoryInNewWindow: Boolean read FShowHistoryInNewWindow write FShowHistoryInNewWindow;
- property ReadMessageHotKey: string read FReadMessageHotKey write SetReadMessageHotKey;
- property CopyScreenHotKey: string read FCopyScreenHotKey write SetCopyScreenHotKey;
- property AutoUpdate: Boolean read FAutoUpdate write FAutoUpdate;
- property AddrBookURL: string read FAddrBookURL write FAddrBookURL;
- property DBHistory: TRealICQDBHistory read FDBHistory;
- // property GroupAddress: string read FGroupAddress write FGroupAddress;
- // property GroupPort: Integer read FGroupPort write FGroupPort;
- // property GroupImagePort: Integer read FGroupImagePort write FGroupImagePort;
- // property GroupShareAddress: string read FGroupShareAddress write FGroupShareAddress;
- // property GroupSharePort: Integer read FGroupSharePort write FGroupSharePort;
- end;
- TUploadMission = class
- private
- FID: string;
- FUploadMissionType: TNDMissionType;
- FDirectoryID: Integer;
- FName: string;
- public
- constructor Create(AUploadMissionType: TNDMissionType; ADirectoryID: Integer; AName: string);
- destructor Destroy; override;
- property ID: string read FID;
- property UploadMissionType: TNDMissionType read FUploadMissionType;
- property DirectoryID: Integer read FDirectoryID;
- property Name: string read FName;
- end;
- TDownloadMission = class
- FID: string;
- FDownloadMissionType: TNDMissionType;
- FFileID: Integer;
- FFileName: string;
- FDirectoryName: string;
- public
- constructor Create(ADownloadMissionType: TNDMissionType; ADirectoryName: string; AFileID: Integer = 0; AFileName: string = '');
- destructor Destroy; override;
- property ID: string read FID;
- property DownloadMissionType: TNDMissionType read FDownloadMissionType;
- property FileID: Integer read FFileID;
- property FileName: string read FFileName;
- property DirectoryName: string read FDirectoryName;
- end;
- TNavigateType = (ntGET, ntPOST, ntFill);
- //WEB标签面版数据
- TWebPanel = class
- private
- FMustShow: Boolean;
- FShow: Boolean;
- FID, FName, FURL, FImage: string;
- FNavigateType: TNavigateType;
- FPostFields: string;
- FUserIMLoginName: Boolean;
- FUserIMPassword: Boolean;
- FCustomLoginName, FCustomPassword: string;
- FContent: string;
- FAcounts: TList;
- public
- constructor Create();
- destructor Destroy; override;
- property MustShow: Boolean read FMustShow write FMustShow;
- property Show: Boolean read FShow write FShow;
- property ID: string read FID write FID;
- property Name: string read FName write FName;
- property URL: string read FURL write FURL;
- property Image: string read FImage write FImage;
- property NavigateType: TNavigateType read FNavigateType write FNavigateType;
- property PostFields: string read FPostFields write FPostFields;
- property UserIMLoginName: Boolean read FUserIMLoginName write FUserIMLoginName;
- property UserIMPassword: Boolean read FUserIMPassword write FUserIMPassword;
- property CustomLoginName: string read FCustomLoginName write FCustomLoginName;
- property CustomPassword: string read FCustomPassword write FCustomPassword;
- property Content: string read FContent write FContent;
- property Acounts: TList read FAcounts write FAcounts;
- end;
-
- //未读消息（文字消息）
- TNotReadMessage = class
- private
- FRealICQMessage: TRealICQMessage;
- FShowSendFailed: Boolean;
- FRealICQClient: TRealICQClient;
- public
- destructor Destroy; override;
- property RealICQMessage: TRealICQMessage read FRealICQMessage write FRealICQMessage;
- property ShowSendFailed: Boolean read FShowSendFailed;
- end;
- //未读消息（文字消息）
- TNotReadTeamMessage = class
- private
- FRealICQTeamMessage: TRealICQTeamMessage;
- FShowSendFailed: Boolean;
- public
- destructor Destroy; override;
- property RealICQTeamMessage: TRealICQTeamMessage read FRealICQTeamMessage write FRealICQTeamMessage;
- property ShowSendFailed: Boolean read FShowSendFailed;
- end;
- //未读消息（手机短消息）
- TNotReadSMSMessage = class
- private
- FSMSSender, FSMSContent: string;
- FSMSDateTime: TDateTime;
- public
- property SMSSender: string read FSMSSender;
- property SMSContent: string read FSMSContent;
- property SMSDateTime: TDateTime read FSMSDateTime;
- end;
- TWebTabAcount = class
- private
- FWebTabID: Integer;
- FTitle: string;
- FLoginName: string;
- FPassword: string;
- FExplain: string;
- public
- published
- property WebTabID: Integer read FWebTabID write FWebTabID;
- property Title: string read FTitle write FTitle;
- property LoginName: string read FLoginName write FLoginName;
- property Password: string read FPassword write FPassword;
- property Explain: string read FExplain write FExplain;
- end;
- //添加表示用户状态的图标至指定的 ImageList 中
- procedure AddUserStatePictureToImageList(ImageList: TImageList);
- procedure ClearFileMissions;
- var
- MainForm: TMainForm;
- DisplayWebs: Boolean;
- LVSystemMessage, LVMyContacters, LVFriends, LVStrangers, LVBlacklists, LVLatests, LVTeams, LVMoreUsers, LVAddrbook, LVSearch: string;
- CsvLines, CommaStr: TStringList;
- implementation
- uses
- RegFrm, SearchFrm, VCardFrm, AddFriendRequestFrm, AddFriendFrm, OptionsFrm,
- ChangePassFrm, GroupManagerFrm, OnlineOfflineAlertFrm, SeeInformationFrm{UserCardDetailView},
- TalkingFrm, TrueHiddenMainFrm, SelFaceFrm, CustomFacesManagerFrm, AddFaceFrm,
- CreateTeamFrm, PtoPFileTransmitter, FileTransmitterObjective, NotifyAlertFrm,
- TeamOptionsFrm, SearchTeamFrm, SystemMessageFrm, MessagesManagerFrm,
- UserCardFrm, VideoFrm, ShareUtils, CopyScreenFrm, SMSFrm,
- ConfirmReplaceNDFileFrm, RemoteControlFrm, ReceiveFolderRequestFrm,
- NotReadMessageBoxFrm, AddWebTabFrm, SelWebTabAcountsFrm,
- LoggerImport, TeamsAdapter, MainFormContrller, Authority, FileTransmitAdapter,
- DataProviderImport, BranchService, UsersService, FriendsService,
- WorkmatesService, MessagesHander, CAImport, InterfaceCA, PerlRegEx,
- GroupConfig, ConditionConfig, LimitCondition,
- AboutFrm, TextMessageService, ViewManager, InterfaceUI, GuideView,
- RealICQUtility;
- var
- HookID: THandle;
- FUploadMissions, FDownloadMissions: TStringList;
- FSavedUploadMissions, FSavedDownloadMissions: TList;
- //------------------------------------------------------------------------------
- procedure AddUserStatePictureToImageList(ImageList: TImageList);
- var
- Bitmap: TBitmap;
- //BitmapLeave: TBitmap;
- //png: TPNGObject;
- //Icon: TIcon;
-
begin
- Bitmap := TBitmap.Create;
- //Icon := TIcon.Create;
- //BitmapLeave := TBitmap.Create;
- //png := TPNGObject.Create;
-
try
- // try
- // Bitmap.LoadFromFile(ExtractFilePath(Application.ExeName) + DefaultPictureSmall);
- // except
- // end;
- // ImageList.Add(Bitmap, nil);
- // Grayscale(Bitmap);
- // ImageList.Insert(0, Bitmap, nil);
- // try
- // Bitmap.LoadFromFile(ExtractFilePath(Application.ExeName) + DefaultPictureSmall);
- // BitmapLeave.LoadFromFile(LeavePicture);
- // Bitmap.Canvas.Draw(0, 8, BitmapLeave);
- // except
- // end;
- // ImageList.Add(Bitmap, nil);
- //-----------------------------------------------
- //png.LoadFromFile(ExtractFilePath(Application.ExeName) + DefaultPictureSmall);
- //Image1.Picture.Bitmap.Assign(png);
- // try
- // Icon.LoadFromFile(ExtractFilePath(Application.ExeName) + DefaultIcon);
- // except
- // end;
- // ImageList.AddIcon(Icon);
- // try
- // Icon.LoadFromFile(ExtractFilePath(Application.ExeName) + DefaultIcon);
- // except
- // end;
- // ImageList.AddIcon(Icon);
- // try
- // Icon.LoadFromFile(ExtractFilePath(Application.ExeName) + DefaultIcon);
- // except
- // end;
- // ImageList.AddIcon(Icon);
-
try
- Bitmap.LoadFromFile(ExtractFilePath(Application.ExeName) + 'Images\Small\DefaultHeadImageOffline_16.bmp');
- except
- end;
- ImageList.Add(Bitmap, nil);
- try
- Bitmap.LoadFromFile(ExtractFilePath(Application.ExeName) + 'Images\Small\DefaultHeadImage_16.bmp');
- except
- end;
- ImageList.Add(Bitmap, nil);
- try
- Bitmap.LoadFromFile(ExtractFilePath(Application.ExeName) + 'Images\Small\DefaultHeadImage_leave_16.bmp');
- except
- end;
- ImageList.Add(Bitmap, nil);
- try
- Bitmap.LoadFromFile(ExtractFilePath(Application.ExeName) + 'Images\OpenFolder.bmp');
- except
- end;
- ImageList.Add(Bitmap, nil);
- try
- Bitmap.LoadFromFile(ExtractFilePath(Application.ExeName) + 'Images\CloseFolder.bmp');
- except
- end;
- ImageList.Add(Bitmap, nil);
- try
- Bitmap.LoadFromFile(ExtractFilePath(Application.ExeName) + TeamPicture);
- except
- end;
- ImageList.Add(Bitmap, nil);
- try
- Bitmap.LoadFromFile(ExtractFilePath(Application.ExeName) + SystemMessagePicture);
- except
- end;
- ImageList.Add(Bitmap, nil);
- try
- Bitmap.LoadFromFile(ExtractFilePath(Application.ExeName) + SearchPicture);
- except
- end;
- ImageList.Add(Bitmap, nil);
- try
- Bitmap.LoadFromFile(ExtractFilePath(Application.ExeName) + SMSBMP);
- except
- end;
- ImageList.Add(Bitmap, nil);
- finally
- //BitmapLeave.Free;
- Bitmap.Free;
- //Icon.Free;
- //png.Free;
- end;
- end;
- //------------------------------------------------------------------------------
- function MouseProc(nCode: Integer; wParam, lParam: Longint): Longint; stdcall;
- var
- szClassName: array[0..255] of Char;
- const
- ie_name = 'Internet Explorer_Server';
- begin
- case nCode < 0 of
- True:
- Result := CallNextHookEx(HookID, nCode, wParam, lParam) else
- case wParam of
- WM_RBUTTONDOWN, WM_RBUTTONUP:
- begin
- GetClassName(PMOUSEHOOKSTRUCT(lParam)^.HWND, szClassName, SizeOf(szClassName));
- if (lstrcmp(@szClassName[0], @ie_name[1]) = 0) and (IsChild(MainForm.WebBrowserForAdvertisement.Handle, PMOUSEHOOKSTRUCT(lParam)^.HWND) or InTalkingFormTeamDisk(PMOUSEHOOKSTRUCT(lParam)^.HWND) or InTalkingFormAdvertisement(PMOUSEHOOKSTRUCT(lParam)^.HWND)) then
- begin
- Result := HC_SKIP {屏蔽WebBrowser上的右键}
-
end
- else
- begin
- Result := CallNextHookEx(HookID, nCode, wParam, lParam);
- end;
- end
- else
- Result := CallNextHookEx(HookID, nCode, wParam, lParam);
- end;
- end;
- end;
- {$R *.dfm}
- {TWebPanel}
- constructor TWebPanel.Create();
- begin
- FAcounts := TList.Create;
- end;
- destructor TWebPanel.Destroy;
- var
- WebTabAcount: TWebTabAcount;
- begin
- try
- while FAcounts.Count > 0 do
- begin
- WebTabAcount := FAcounts[0];
- FAcounts.Delete(0);
- try
- FreeAndNil(WebTabAcount);
- except
- end;
- end;
- try
- FreeAndNil(FAcounts);
- except
- end;
- finally
- inherited Destroy;
- end;
- end;
- {TDownloadMission}
- //------------------------------------------------------------------------------
- constructor TDownloadMission.Create(ADownloadMissionType: TNDMissionType; ADirectoryName: string; AFileID: Integer = 0; AFileName: string = '');
- begin
- FDownloadMissionType := ADownloadMissionType;
- FDirectoryName := ADirectoryName;
- FFileID := AFileID;
- FFileName := AFileName;
- FID := IntToStr(GetTickCount);
- while FDownloadMissions.IndexOf(FID) >= 0 do
- begin
- FID := IntToStr(GetTickCount);
- Sleep(10);
- Application.ProcessMessages;
- end;
- FDownloadMissions.AddObject(FID, Self);
- end;
- //------------------------------------------------------------------------------
- destructor TDownloadMission.Destroy;
- begin
- try
- try
- FDownloadMissions.Delete(FDownloadMissions.IndexOf(FID));
- except
- end;
- finally
- inherited Destroy;
- end;
- end;
- {TUploadMission}
- //------------------------------------------------------------------------------
- constructor TUploadMission.Create(AUploadMissionType: TNDMissionType; ADirectoryID: Integer; AName: string);
- begin
- FUploadMissionType := AUploadMissionType;
- FDirectoryID := ADirectoryID;
- FName := AName;
- FID := IntToStr(Integer(FUploadMissionType)) + IntToStr(FDirectoryID) + FName;
- end;
- //------------------------------------------------------------------------------
- destructor TUploadMission.Destroy;
- begin
- try
- try
- FUploadMissions.Delete(FUploadMissions.IndexOf(FID));
- except
- end;
- finally
- inherited Destroy;
- end;
- end;
- {TNotReadMessage}
- //------------------------------------------------------------------------------
- destructor TNotReadMessage.Destroy;
- begin
- try
- FreeAndNil(FRealICQMessage);
- finally
- inherited Destroy;
- end;
- end;
- {TNotReadTeamMessage}
- //------------------------------------------------------------------------------
- destructor TNotReadTeamMessage.Destroy;
- begin
- try
- FreeAndNil(FRealICQTeamMessage);
- finally
- inherited Destroy;
- end;
- end;
- {TMainForm}
- function TMainForm.GetBitmapFromFileExt(AFileName: string): string;
- var
- FileExt, IconTempFileName, FFileExtImage: string;
- TempFile: array[0..MAX_PATH] of char;
- SHFI: TSHFileInfo;
- Bitmap: TBitmap;
- begin
- try
- FileExt := ExtractFileExt(AFileName);
- FFileExtImage := TRealICQClient.GetFileExtImagesDir + Copy(FileExt, 2, Length(FileExt) - 1) + '.BMP';
- if not FileExists(FFileExtImage) then
- begin
- GetTempPath(MAX_PATH, TempFile);
- GetTempFileName(TempFile, PChar(FileExt), GetTickCount, TempFile);
- IconTempFileName := ReplaceStr(TempFile, ExtractFileExt(TempFile), FileExt);
- TFileStream.Create(IconTempFileName, fmCreate).Free;
- SHGetFileInfo(PChar(IconTempFileName), 0, SHFI, SizeOf(SHFI), SHGFI_ICON or SHGFI_SMALLICON);
- DeleteFile(PChar(IconTempFileName));
- Bitmap := TBitmap.Create;
- try
- Bitmap.Width := 16;
- Bitmap.Height := 16;
- DrawIconEx(Bitmap.Canvas.Handle, 0, 0, SHFI.hIcon, 16, 16, 0, 0, DI_NORMAL);
- Bitmap.SaveToFile(FFileExtImage);
- finally
- FreeAndNil(Bitmap);
- end;
- end;
- Result := FFileExtImage;
- except
- end;
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.SetShowMainFormOnStart(Value: Boolean);
- begin
- if FShowMainFormOnStart = Value then
- Exit;
- FShowMainFormOnStart := Value;
- SaveDefaultConfigs;
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.SetTalkingFormAlwaysOnTop(Value: Boolean);
- begin
- if FTalkingFormAlwaysOnTop = Value then
- Exit;
- FTalkingFormAlwaysOnTop := Value;
- SaveStyleConfigs;
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.SetCtrlEnterSendMessage(Value: Boolean);
- begin
- if FCtrlEnterSendMessage = Value then
- Exit;
- FCtrlEnterSendMessage := Value;
- SaveStyleConfigs;
- end;
- procedure TMainForm.SetCopyScreenHideTalkForm(Value: Boolean);
- begin
- if FCopyScreenHideTalkForm = Value then
- Exit;
- FCopyScreenHideTalkForm := Value;
- SaveStyleConfigs;
- end;
- procedure TMainForm.SetShowGroup(Value: Boolean);
- begin
- FShowGroup := Value;
- ShowGroupInterface;
- end;
- procedure TMainForm.SaveIfShowGroupConfig;
- var
- XMLFile: string;
- XMLDocument: TXMLDocument;
- GroupConfigNode: IXMLNode;
- begin
- XMLFile := TRealICQClient.GetUserDir + GroupConfigXMLFile;
- XMLDocument := TXMLDocument.Create(Self);
- try
- XMLDocument.Active := True;
- if not FileExists(XMLFile) then
- begin
- CopyFile(PChar(ExtractFilePath(paramstr(0)) + ConfigXMLFilePath + GroupConfigXMLFile), PChar(XMLFile), False);
- XMLDocument.Active := True;
- end;
- XMLDocument.LoadFromFile(XMLFile);
- GroupConfigNode := XMLDocument.DocumentElement;
- GroupConfigNode.ChildNodes.FindNode('ShowGroup').Attributes['Value'] := FShowGroup;
- XMLDocument.SaveToFile();
- finally
- XMLDocument.Free;
- end;
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.SaveGroupConfigs;
- var
- XMLFile: string;
- XMLDocument: TXMLDocument;
- GroupConfigNode, GroupListNode, GroupNode: IXMLNode;
- GroupMembers: TStringList;
- iLoop, jLoop: Integer;
- begin
- XMLFile := TRealICQClient.GetUserDir + GroupConfigXMLFile;
- XMLDocument := TXMLDocument.Create(Self);
- try
- XMLDocument.Active := True;
- if not FileExists(XMLFile) then
- begin
- CopyFile(PChar(ExtractFilePath(paramstr(0)) + ConfigXMLFilePath + GroupConfigXMLFile), PChar(XMLFile), False);
- XMLDocument.Active := True;
- end;
- XMLDocument.LoadFromFile(XMLFile);
- GroupConfigNode := XMLDocument.DocumentElement;
- GroupListNode := GroupConfigNode.ChildNodes.FindNode('Groups');
- for iLoop := 0 to GroupListNode.ChildNodes.Count - 1 do
- begin
- GroupNode := GroupListNode.ChildNodes[iLoop];
- GroupNode.ChildNodes.Clear;
- end;
- GroupListNode.ChildNodes.Clear;
- for iLoop := 0 to FGroups.Count - 1 do
- begin
- GroupNode := GroupListNode.AddChild('Group');
- GroupNode.Attributes['Name'] := FGroups[iLoop];
- GroupNode.Attributes['Position'] := iLoop;
- GroupMembers := FGroups.Objects[iLoop] as TStringList;
- for jLoop := 0 to GroupMembers.Count - 1 do
- begin
- if (not TFriendsService.GetService.IsFriend(GroupMembers[jLoop])) and (not TWorkmatesService.GetService.IsWorkmate(GroupMembers[jLoop])) then
- continue;
- if (AnsiSameText(RealICQClient.LoginName, GroupMembers[jLoop]) and (RealICQClient.WorkingMode = wmPublic)) then
- continue;
- GroupNode.AddChild('GroupMember').Text := GroupMembers[jLoop];
- end;
- end;
- XMLDocument.SaveToFile();
- finally
- XMLDocument.Free;
- end;
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.SetInputFont(Value: TFont);
- begin
- FInputFont.Assign(Value);
- SaveInputFontConfig;
- end;
- //------------------------------------------------------------------------------
- function TMainForm.GetSystemMessageCounter(AMessageID: Integer): Integer;
- var
- XMLFile: string;
- XMLDocument: TXMLDocument;
- CountersNode, CounterNode: IXMLNode;
- iLoop: Integer;
- CountersDate: TDateTime;
- begin
- Result := 0;
- XMLFile := TRealICQClient.GetUserDir + SystemMessagesCounterXMLFile;
- XMLDocument := TXMLDocument.Create(Self);
- try
- try
- XMLDocument.Active := True;
- if not FileExists(XMLFile) then
- begin
- CopyFile(PChar(ExtractFilePath(paramstr(0)) + ConfigXMLFilePath + SystemMessagesCounterXMLFile), PChar(XMLFile), False);
- XMLDocument.Active := True;
- end;
- XMLDocument.LoadFromFile(XMLFile);
- CountersNode := XMLDocument.DocumentElement;
- try
- CountersDate := StrToDate(CountersNode.Attributes['Date']);
- except
- CountersDate := StrToDate(AnsiReplaceStr(CountersNode.Attributes['Date'], '-', '/'));
- end;
- if CompareDate(CountersDate, Now) <> 0 then
- begin
- CountersNode.Attributes['Date'] := DateToStr(Now);
- CountersNode.ChildNodes.Clear;
- XMLDocument.SaveToFile();
- Exit;
- end;
- for iLoop := 0 to CountersNode.ChildNodes.Count - 1 do
- begin
- CounterNode := CountersNode.ChildNodes[iLoop];
- if StrToInt(CounterNode.Attributes['ID']) = AMessageID then
- begin
- Result := StrToInt(CounterNode.Attributes['Counter']);
- Exit;
- end;
- end;
- finally
- XMLDocument.Free;
- end;
- except
- try
- DeleteFile(XMLFile);
- except
- end;
- Result := 0;
- end;
- end;
- //------------------------------------------------------------------------------
- //procedure TMainForm.ImgQrCodeClick(Sender: TObject);
- //begin
- // QRCodeForm := TQRCodeForm.Create(Self);
- // try
- // QRCodeForm.ShowModal;
- // finally
- // FreeAndNil(QRCodeForm);
- // end;
- //end;
- procedure TMainForm.IncSystemMessageCounter(AMessageID: Integer);
- var
- XMLFile: string;
- XMLDocument: TXMLDocument;
- CountersNode, CounterNode: IXMLNode;
- iLoop: Integer;
- Finded: Boolean;
- CountersDate: TDateTime;
- begin
- XMLFile := TRealICQClient.GetUserDir + SystemMessagesCounterXMLFile;
- XMLDocument := TXMLDocument.Create(Self);
- try
- XMLDocument.Active := True;
- if not FileExists(XMLFile) then
- begin
- CopyFile(PChar(ExtractFilePath(paramstr(0)) + ConfigXMLFilePath + SystemMessagesCounterXMLFile), PChar(XMLFile), False);
- XMLDocument.Active := True;
- end;
- XMLDocument.LoadFromFile(XMLFile);
- CountersNode := XMLDocument.DocumentElement;
- try
- CountersDate := StrToDate(CountersNode.Attributes['Date']);
- except
- CountersDate := StrToDate(AnsiReplaceStr(CountersNode.Attributes['Date'], '-', '/'));
- end;
- if CompareDate(CountersDate, Now) <> 0 then
- begin
- CountersNode.Attributes['Date'] := DateToStr(Now);
- CountersNode.ChildNodes.Clear;
- end;
- Finded := False;
- for iLoop := 0 to CountersNode.ChildNodes.Count - 1 do
- begin
- CounterNode := CountersNode.ChildNodes[iLoop];
- if StrToInt(CounterNode.Attributes['ID']) = AMessageID then
- begin
- CounterNode.Attributes['Counter'] := IntToStr(StrToInt(CounterNode.Attributes['Counter']) + 1);
- Finded := True;
- Break;
- end;
- end;
- if not Finded then
- begin
- CounterNode := CountersNode.AddChild('SystemMessage');
- CounterNode.Attributes['ID'] := IntToStr(AMessageID);
- CounterNode.Attributes['Counter'] := '1';
- end;
- XMLDocument.SaveToFile();
- finally
- XMLDocument.Free;
- end;
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.SaveCustomFaceConfig;
- var
- XMLFile, FaceCategorys: string;
- XMLDocument: TXMLDocument;
- InputConfigNode, FacesNode, FaceNode: IXMLNode;
- iLoop, jLoop: Integer;
- Face: TFace;
- begin
- XMLFile := TRealICQClient.GetUserDir + InputConfigXMLFile;
- XMLDocument := TXMLDocument.Create(Self);
- try
- XMLDocument.Active := True;
- if not FileExists(XMLFile) then
- begin
- CopyFile(PChar(ExtractFilePath(paramstr(0)) + ConfigXMLFilePath + InputConfigXMLFile), PChar(XMLFile), False);
- XMLDocument.Active := True;
- //删除系统表情
- XMLDocument.LoadFromFile(XMLFile);
- InputConfigNode := XMLDocument.DocumentElement;
- FacesNode := InputConfigNode.ChildNodes.FindNode('Faces');
- FacesNode.ChildNodes.Clear;
- XMLDocument.SaveToFile();
- XMLDocument.Active := False;
- end;
- XMLDocument.Active := True;
- XMLDocument.LoadFromFile(XMLFile);
- InputConfigNode := XMLDocument.DocumentElement;
- if InputConfigNode.ChildNodes.FindNode('FaceCategory') = nil then
- begin
- InputConfigNode.AddChild('FaceCategory').Text := '';
- XMLDocument.SaveToFile();
- end;
- FacesNode := InputConfigNode.ChildNodes.FindNode('Faces');
- FacesNode.ChildNodes.Clear;
- FaceCategorys := '';
- for iLoop := 0 to FFaceCategory.Count - 1 do
- begin
- for jLoop := FSystemFaceCount to FaceList.Count - 1 do
- begin
- Face := FaceList.Objects[jLoop] as TFace;
- if AnsiSameText(Face.Category, FFaceCategory[iLoop]) then
- begin
- FaceNode := FacesNode.AddChild('Face');
- FaceNode.Text := ExtractFileName(Face.FileName);
- FaceNode.Attributes['ShortCut'] := Face.ShortCut;
- FaceNode.Attributes['Name'] := Face.Name;
- FaceNode.Attributes['MD5Code'] := Face.MD5Code;
- FaceNode.Attributes['Category'] := Face.Category;
- end;
- end;
- if iLoop < FFaceCategory.Count - 1 then
- FaceCategorys := FaceCategorys + FFaceCategory[iLoop] + ','
- else
- FaceCategorys := FaceCategorys + FFaceCategory[iLoop];
- end;
- InputConfigNode.ChildNodes.FindNode('FaceCategory').Text := FaceCategorys;
- if SelFaceForm <> nil then
- SelFaceForm.ReDrawFaces;
- XMLDocument.SaveToFile();
- finally
- XMLDocument.Free;
- end;
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.SaveInputFontConfig;
- var
- XMLFile: string;
- XMLDocument: TXMLDocument;
- InputConfigNode, FacesNode: IXMLNode;
- begin
- XMLFile := TRealICQClient.GetUserDir + InputConfigXMLFile;
- XMLDocument := TXMLDocument.Create(Self);
- try
- XMLDocument.Active := True;
- if not FileExists(XMLFile) then
- begin
- CopyFile(PChar(ExtractFilePath(paramstr(0)) + ConfigXMLFilePath + InputConfigXMLFile), PChar(XMLFile), False);
- XMLDocument.Active := True;
- //删除系统表情
- XMLDocument.LoadFromFile(XMLFile);
- InputConfigNode := XMLDocument.DocumentElement;
- FacesNode := InputConfigNode.ChildNodes.FindNode('Faces');
- FacesNode.ChildNodes.Clear;
- XMLDocument.SaveToFile();
- XMLDocument.Active := False;
- end;
- XMLDocument.Active := True;
- XMLDocument.LoadFromFile(XMLFile);
- InputConfigNode := XMLDocument.DocumentElement;
- try
- InputConfigNode.ChildNodes.FindNode('Font').Text := FontToString(FInputFont);
- except
- InputConfigNode.ChildNodes.FindNode('Font').Text := FontToString(Font);
- end;
- XMLDocument.SaveToFile();
- finally
- XMLDocument.Free;
- end;
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.LoadInputConfigs;
- var
- XMLFile: string;
- XMLDocument: TXMLDocument;
- InputConfigNode, FacesNode, FaceNode: IXMLNode;
- Face: TFace;
- iLoop: Integer;
- Category: string;
- begin
- FInputFont.Assign(Font);
- {$region '删除前一个用户的表情'}
- TRealICQUtility.ClearStringList(FFaceList);
- TRealICQUtility.ClearStringList(FTempFaceList);
- FFaceCategory.Clear;
- FSystemFaceCount := 0;
- {$endregion}
- {$region '读取系统表情'}
- FFaceCategory.Add(SystemFaceGroup);
- XMLFile := ExtractFilePath(paramstr(0)) + ConfigXMLFilePath + InputConfigXMLFile;
- SetFileAttributes(Pchar(XMLFile), file_attribute_normal);
- XMLDocument := TXMLDocument.Create(Self);
- try
- XMLDocument.Active := True;
- XMLDocument.LoadFromFile(XMLFile);
- InputConfigNode := XMLDocument.DocumentElement;
- try
- StringToFont(InputConfigNode.ChildNodes.FindNode('Font').Text, FInputFont);
- except
- FInputFont.Assign(Font);
- end;
- FacesNode := InputConfigNode.ChildNodes.FindNode('Faces');
- for iLoop := 0 to FacesNode.ChildNodes.Count - 1 do
- begin
- FaceNode := FacesNode.ChildNodes[iLoop];
- Face := TFace.Create(ExtractFilePath(paramstr(0)) + FaceNode.Text, FaceNode.Attributes['ShortCut'], FaceNode.Attributes['Name'], '', SystemFaceGroup);
- FFaceList.AddObject(Face.ShortCut, Face);
- Inc(FSystemFaceCount);
- end;
- finally
- XMLDocument.Free;
- end;
- {$endregion}
-
- {$region '读取自定义表情'}
- XMLFile := TRealICQClient.GetUserDir + InputConfigXMLFile;
- XMLDocument := TXMLDocument.Create(Self);
- try
- XMLDocument.Active := True;
- if not FileExists(XMLFile) then
- begin
- CopyFile(PChar(ExtractFilePath(paramstr(0)) + ConfigXMLFilePath + InputConfigXMLFile), PChar(XMLFile), False);
- XMLDocument.Active := True;
- //删除系统表情
- XMLDocument.LoadFromFile(XMLFile);
- InputConfigNode := XMLDocument.DocumentElement;
- FacesNode := InputConfigNode.ChildNodes.FindNode('Faces');
- FacesNode.ChildNodes.Clear;
- XMLDocument.SaveToFile();
- XMLDocument.Active := False;
- end;
- XMLDocument.Active := True;
- XMLDocument.LoadFromFile(XMLFile);
- InputConfigNode := XMLDocument.DocumentElement;
- try
- StringToFont(InputConfigNode.ChildNodes.FindNode('Font').Text, FInputFont);
- except
- FInputFont.Assign(Font);
- end;
- if InputConfigNode.ChildNodes.FindNode('FaceCategory') = nil then
- begin
- InputConfigNode.AddChild('FaceCategory').Text := '';
- XMLDocument.SaveToFile();
- end;
- FreeAndNil(FFaceCategory);
- FFaceCategory := SplitString(InputConfigNode.ChildNodes.FindNode('FaceCategory').Text, ',');
- if FFaceCategory.IndexOf('') >= 0 then
- FFaceCategory.Delete(FFaceCategory.IndexOf(''));
- FacesNode := InputConfigNode.ChildNodes.FindNode('Faces');
- for iLoop := 0 to FacesNode.ChildNodes.Count - 1 do
- begin
- FaceNode := FacesNode.ChildNodes[iLoop];
- try
- Category := FaceNode.Attributes['Category'];
- except
- Category := NOFaceCategory;
- end;
- if FFaceCategory.IndexOf(Category) = -1 then
- begin
- if AnsiSameText(Category, NOFaceCategory) then
- FFaceCategory.Insert(0, Category)
- else
- FFaceCategory.Add(Category);
- end;
- Face := TFace.Create(TRealICQClient.GetCustomFaceDir + FaceNode.Text, FaceNode.Attributes['ShortCut'], FaceNode.Attributes['Name'], FaceNode.Attributes['MD5Code'], Category);
- FFaceList.AddObject(Face.MD5Code, Face);
- end;
- finally
- XMLDocument.Free;
- end;
- {$endregion}
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.LoadSafeConfigs;
- var
- XMLFile: string;
- XMLDocument: TXMLDocument;
- SafeConfigNode: IXMLNode;
- begin
- XMLFile := TRealICQClient.GetUserDir + SafeConfigXMLFile;
- SetFileAttributes(Pchar(XMLFile), file_attribute_normal);
- XMLDocument := TXMLDocument.Create(Self);
- try
- XMLDocument.Active := True;
- if not FileExists(XMLFile) then
- begin
- CopyFile(PChar(ExtractFilePath(paramstr(0)) + ConfigXMLFilePath + SafeConfigXMLFile), PChar(XMLFile), False);
- XMLDocument.Active := True;
- end;
- XMLDocument.LoadFromFile(XMLFile);
- SafeConfigNode := XMLDocument.DocumentElement;
- FRecvFileSafeLevel := TRecvFileSafeLevel(Integer(SafeConfigNode.ChildNodes.FindNode('RecvFileSafeLevel').Attributes['Value']));
- FAllowURL := SafeConfigNode.ChildNodes.FindNode('AllowURL').Attributes['Value'];
- FShowHistoryInNewWindow := SafeConfigNode.ChildNodes.FindNode('ShowHistoryInNewWindow').Attributes['Value'];
- FAutoSaveMessage := SafeConfigNode.ChildNodes.FindNode('AutoSaveMessage').Attributes['Value'];
- finally
- XMLDocument.Free;
- end;
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.SaveSafeConfigs;
- var
- XMLFile: string;
- XMLDocument: TXMLDocument;
- SafeConfigNode: IXMLNode;
- begin
- XMLFile := TRealICQClient.GetUserDir + SafeConfigXMLFile;
- XMLDocument := TXMLDocument.Create(Self);
- try
- XMLDocument.Active := True;
- if not FileExists(XMLFile) then
- begin
- CopyFile(PChar(ExtractFilePath(paramstr(0)) + ConfigXMLFilePath + SafeConfigXMLFile), PChar(XMLFile), False);
- XMLDocument.Active := True;
- end;
- XMLDocument.LoadFromFile(XMLFile);
- SafeConfigNode := XMLDocument.DocumentElement;
- SafeConfigNode.ChildNodes.FindNode('RecvFileSafeLevel').Attributes['Value'] := Integer(FRecvFileSafeLevel);
- SafeConfigNode.ChildNodes.FindNode('AllowURL').Attributes['Value'] := FAllowURL;
- SafeConfigNode.ChildNodes.FindNode('ShowHistoryInNewWindow').Attributes['Value'] := FShowHistoryInNewWindow;
- SafeConfigNode.ChildNodes.FindNode('AutoSaveMessage').Attributes['Value'] := FAutoSaveMessage;
- XMLDocument.SaveToFile();
- finally
- XMLDocument.Free;
- end;
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.LoadWebPanelsFromXML;
- var
- ADesKey: string;
- iLoop: Integer;
- XMLFile: string;
- XMLDocument: TXMLDocument;
- WebPanelsNode, WebPanelNode: IXMLNode;
- WebPanel: TWebPanel;
- begin
- XMLFile := TRealICQClient.GetUserDir + WebPanelsXMLFile;
- XMLDocument := TXMLDocument.Create(Self);
- try
- try
- XMLDocument.Active := True;
- if not FileExists(XMLFile) then
- begin
- XMLDocument.XML.Text := '<?xml version="1.0"?>' + '<WebPanels>' + '</WebPanels>';
- XMLDocument.Active := True;
- XMLDocument.SaveToFile(XMLFile);
- end
- else
- begin
- XMLDocument.LoadFromFile(XMLFile);
- end;
- WebPanelsNode := XMLDocument.DocumentElement;
- while FWebPanels.Count > 0 do
- begin
- FWebPanels.Objects[0].Free;
- FWebPanels.Delete(0);
- end;
- FWebPanels.Clear;
- ADesKey := MD5En(RealICQClient.LoginName);
- for iLoop := WebPanelsNode.ChildNodes.Count - 1 downto 0 do
- begin
- WebPanelNode := WebPanelsNode.ChildNodes[iLoop];
- WebPanel := TWebPanel.Create;
- try
- WebPanel.FMustShow := WebPanelNode.Attributes['MustShow'];
- except
- WebPanel.FMustShow := False;
- end;
- try
- WebPanel.FShow := WebPanelNode.Attributes['Show'];
- except
- WebPanel.FShow := False;
- end;
- try
- WebPanel.FID := WebPanelNode.Attributes['ID'];
- except
- WebPanel.FID := '';
- end;
- WebPanel.FName := DESryStrHex(WebPanelNode.Attributes['Name'], ADesKey);
- WebPanel.FURL := DESryStrHex(WebPanelNode.Attributes['URL'], ADesKey);
- WebPanel.FImage := DESryStrHex(WebPanelNode.Attributes['Image'], ADesKey);
- WebPanel.FNavigateType := WebPanelNode.Attributes['NavigateType'];
- WebPanel.FPostFields := DESryStrHex(WebPanelNode.Attributes['PostFields'], ADesKey);
- WebPanel.FUserIMLoginName := WebPanelNode.Attributes['UserIMLoginName'];
- WebPanel.FUserIMPassword := WebPanelNode.Attributes['UserIMPassword'];
- WebPanel.FCustomLoginName := DESryStrHex(WebPanelNode.Attributes['CustomLoginName'], ADesKey);
- WebPanel.FCustomPassword := DESryStrHex(WebPanelNode.Attributes['CustomPassword'], ADesKey);
- FWebPanels.AddObject(WebPanel.FID, WebPanel);
- end;
- except
- end;
- finally
- XMLDocument.Free;
- end;
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.SaveWebPanelsToXML;
- var
- ADesKey: string;
- iLoop: Integer;
- XMLFile: string;
- XMLDocument: TXMLDocument;
- WebPanelsNode, WebPanelNode: IXMLNode;
- WebPanel: TWebPanel;
- begin
- XMLFile := TRealICQClient.GetUserDir + WebPanelsXMLFile;
- XMLDocument := TXMLDocument.Create(Self);
- try
- try
- XMLDocument.Active := True;
- if not FileExists(XMLFile) then
- begin
- XMLDocument.XML.Text := '<?xml version="1.0"?>' + '<WebPanels>' + '</WebPanels>';
- XMLDocument.Active := True;
- end
- else
- begin
- XMLDocument.LoadFromFile(XMLFile);
- end;
- WebPanelsNode := XMLDocument.DocumentElement;
- ADesKey := MD5En(RealICQClient.LoginName);
- WebPanelsNode.ChildNodes.Clear;
- for iLoop := 0 to FWebPanels.Count - 1 do
- begin
- WebPanel := FWebPanels.Objects[iLoop] as TWebPanel;
- WebPanelNode := WebPanelsNode.AddChild('WebPanel');
- WebPanelNode.Attributes['MustShow'] := WebPanel.FMustShow;
- WebPanelNode.Attributes['Show'] := WebPanel.FShow;
- WebPanelNode.Attributes['ID'] := WebPanel.FID;
- WebPanelNode.Attributes['Name'] := EncryStrHex(WebPanel.FName, ADesKey);
- WebPanelNode.Attributes['URL'] := EncryStrHex(WebPanel.FURL, ADesKey);
- WebPanelNode.Attributes['Image'] := EncryStrHex(WebPanel.FImage, ADesKey);
- WebPanelNode.Attributes['NavigateType'] := WebPanel.FNavigateType;
- WebPanelNode.Attributes['PostFields'] := EncryStrHex(WebPanel.FPostFields, ADesKey);
- WebPanelNode.Attributes['UserIMLoginName'] := WebPanel.FUserIMLoginName;
- WebPanelNode.Attributes['UserIMPassword'] := WebPanel.FUserIMPassword;
- WebPanelNode.Attributes['CustomLoginName'] := EncryStrHex(WebPanel.FCustomLoginName, ADesKey);
- WebPanelNode.Attributes['CustomPassword'] := EncryStrHex(WebPanel.FCustomPassword, ADesKey);
- end;
- XMLDocument.SaveToFile(XMLFile);
- except
- end;
- finally
- XMLDocument.Free;
- end;
- end;
- {
- //----------------------------------------------------------
- procedure TMainForm.LoadSysMsgInterfaceConfig;
- var
- XMLFile: String;
- XMLDocument: TXMLDocument;
- ConfigNodes,ConfigNode: IXMLNode;
- iLoop:Integer;
- SysMsgInterface:TSysMsgInterface;
- MsgIID:String;
- begin
- XMLFile := TRealICQClient.GetUserDir+SysMsgInterfaceConfig;
- XMLDocument := TXMLDocument.Create(Self);
- try
- try
- XMLDocument.Active := True;
- if not FileExists(XMLFile) then
- begin
- XMLDocument.XML.Text := '<?xml version="1.0"?>' +
- '<SysMsgInterfaces>' +
- '</SysMsgInterfaces>';
- XMLDocument.Active := True;
- XMLDocument.SaveToFile(XMLFile);
- end
- else
- begin
- XMLDocument.LoadFromFile(XMLFile);
- end;
- ConfigNodes := XMLDocument.DocumentElement;
- for iLoop := 0 to ConfigNodes.ChildNodes.Count - 1 do
- begin
- ConfigNode:=ConfigNodes.ChildNodes[iLoop];
- MsgIID:=ConfigNode.Attributes['MsgIID'];
- if MainForm.RealICQClient.SysMsgInterfaces.IndexOf(MsgIID)>=0 then
- begin
- SysMsgInterface:=MainForm.RealICQClient.SysMsgInterfaces.Objects[MainForm.RealICQClient.SysMsgInterfaces.IndexOf(MsgIID)] as TSysMsgInterface;
- SysMsgInterface.ShowMsg:=ConfigNode.Attributes['ShowMsg'];
- end;
- end;
- except
- //
- end;
- finally
- XMLDocument.Free;
- end;
- end; }
- {
- //-----------------------------------------------------------
- procedure TMainForm.SaveSysMsgInterfaceConfig;
- var
- XMLFile: String;
- XMLDocument: TXMLDocument;
- ConfigNodes,ConfigNode: IXMLNode;
- iLoop:Integer;
- SysMsgInterface:TSysMsgInterface;
- begin
- XMLFile := TRealICQClient.GetUserDir+SysMsgInterfaceConfig;
- XMLDocument := TXMLDocument.Create(Self);
- try
- try
- XMLDocument.Active := True;
- if not FileExists(XMLFile) then
- begin
- XMLDocument.XML.Text := '<?xml version="1.0"?>' +
- '<SysMsgInterfaces>' +
- '</SysMsgInterfaces>';
- XMLDocument.Active := True;
- end
- else
- begin
- XMLDocument.LoadFromFile(XMLFile);
- end;
- ConfigNodes := XMLDocument.DocumentElement;
- ConfigNodes.ChildNodes.Clear;
- for iLoop := 0 to MainForm.RealICQClient.SysMsgInterfaces.Count - 1 do
- begin
- SysMsgInterface:=MainForm.RealICQClient.SysMsgInterfaces.Objects[iLoop] as TSysMsgInterface;
- ConfigNode:=ConfigNodes.AddChild('SysMsgInterface');
- ConfigNode.Attributes['MsgIID']:=SysMsgInterface.MsgIID;
- ConfigNode.Attributes['ShowMsg']:=SysMsgInterface.ShowMsg;
- end;
- XMLDocument.SaveToFile(XMLFile);
- except
- end;
- finally
- XMLDocument.Free;
- end;
- end; }
- //------------------------------------------------------------------------------
- procedure TMainForm.LoadReceiveFileConfigs;
- var
- XMLFile: string;
- XMLDocument: TXMLDocument;
- ReceiveFileConfigNode: IXMLNode;
- begin
- XMLFile := TRealICQClient.GetUserDir + ReceiveFileConfigXMLFile;
- SetFileAttributes(Pchar(XMLFile), file_attribute_normal);
- XMLDocument := TXMLDocument.Create(Self);
- try
- XMLDocument.Active := True;
- if not FileExists(XMLFile) then
- begin
- CopyFile(PChar(ExtractFilePath(paramstr(0)) + ConfigXMLFilePath + ReceiveFileConfigXMLFile), PChar(XMLFile), False);
- XMLDocument.Active := True;
- end;
- XMLDocument.LoadFromFile(XMLFile);
- ReceiveFileConfigNode := XMLDocument.DocumentElement;
- FRecvFileDir := ReceiveFileConfigNode.ChildNodes.FindNode('RecvFileDir').Attributes['Value'];
- FUseCacheDir := ReceiveFileConfigNode.ChildNodes.FindNode('UseCacheDir').Attributes['Value'];
- FCacheDir := ReceiveFileConfigNode.ChildNodes.FindNode('CacheDir').Attributes['Value'];
- FLimitCacheDirSize := ReceiveFileConfigNode.ChildNodes.FindNode('LimitCacheDirSize').Attributes['Value'];
- FMaxCacheDirSize := ReceiveFileConfigNode.ChildNodes.FindNode('LimitCacheDirSize').Attributes['MaxSize'];
- FAudoDeleteCacheFile := ReceiveFileConfigNode.ChildNodes.FindNode('AudoDeleteCacheFile').Attributes['Value'];
- FAudoDeleteCacheFileDate := ReceiveFileConfigNode.ChildNodes.FindNode('AudoDeleteCacheFile').Attributes['Date'];
- FScanVirus := ReceiveFileConfigNode.ChildNodes.FindNode('ScanVirus').Attributes['Value'];
- FScanVirusProgram := ReceiveFileConfigNode.ChildNodes.FindNode('ScanVirus').Attributes['Program'];
- FDontUseCacheFileOnBigFile := ReceiveFileConfigNode.ChildNodes.FindNode('DontUseCacheFileOnBigFile').Attributes['Value'];
- FDontUseCacheFileOnBigFileSize := ReceiveFileConfigNode.ChildNodes.FindNode('DontUseCacheFileOnBigFile').Attributes['Size'];
- if not DirectoryExists(FRecvFileDir) then
- begin
- FRecvFileDir := RealICQClient.GetUserDir + '我接收到的文件\';
- if not DirectoryExists(FRecvFileDir) then
- CreateDir(FRecvFileDir);
- end;
- if (not DirectoryExists(FCacheDir)) and FUseCacheDir then
- begin
- FCacheDir := RealICQClient.GetUserDir + 'CacheFiles\';
- if not DirectoryExists(FCacheDir) then
- CreateDir(FCacheDir);
- end;
- finally
- XMLDocument.Free;
- end;
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.SaveReceiveFileConfigs;
- var
- XMLFile: string;
- XMLDocument: TXMLDocument;
- ReceiveFileConfigNode: IXMLNode;
- begin
- XMLFile := TRealICQClient.GetUserDir + ReceiveFileConfigXMLFile;
- XMLDocument := TXMLDocument.Create(Self);
- try
- XMLDocument.Active := True;
- if not FileExists(XMLFile) then
- begin
- CopyFile(PChar(ExtractFilePath(paramstr(0)) + ConfigXMLFilePath + ReceiveFileConfigXMLFile), PChar(XMLFile), False);
- XMLDocument.Active := True;
- end;
- XMLDocument.LoadFromFile(XMLFile);
- ReceiveFileConfigNode := XMLDocument.DocumentElement;
- ReceiveFileConfigNode.ChildNodes.FindNode('RecvFileDir').Attributes['Value'] := FRecvFileDir;
- ReceiveFileConfigNode.ChildNodes.FindNode('UseCacheDir').Attributes['Value'] := FUseCacheDir;
- ReceiveFileConfigNode.ChildNodes.FindNode('CacheDir').Attributes['Value'] := FCacheDir;
- ReceiveFileConfigNode.ChildNodes.FindNode('LimitCacheDirSize').Attributes['Value'] := FLimitCacheDirSize;
- ReceiveFileConfigNode.ChildNodes.FindNode('LimitCacheDirSize').Attributes['MaxSize'] := FMaxCacheDirSize;
- ReceiveFileConfigNode.ChildNodes.FindNode('AudoDeleteCacheFile').Attributes['Value'] := FAudoDeleteCacheFile;
- ReceiveFileConfigNode.ChildNodes.FindNode('AudoDeleteCacheFile').Attributes['Date'] := FAudoDeleteCacheFileDate;
- ReceiveFileConfigNode.ChildNodes.FindNode('ScanVirus').Attributes['Value'] := FScanVirus;
- ReceiveFileConfigNode.ChildNodes.FindNode('ScanVirus').Attributes['Program'] := FScanVirusProgram;
- ReceiveFileConfigNode.ChildNodes.FindNode('DontUseCacheFileOnBigFile').Attributes['Value'] := FDontUseCacheFileOnBigFile;
- ReceiveFileConfigNode.ChildNodes.FindNode('DontUseCacheFileOnBigFile').Attributes['Size'] := FDontUseCacheFileOnBigFileSize;
- XMLDocument.SaveToFile();
- finally
- XMLDocument.Free;
- end;
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.LoadOfflineAutoResponseSets;
- var
- XMLFile: string;
- XMLDocument: TXMLDocument;
- OfflineAutoResponseConfigNode, TextNode: IXMLNode;
- iLoop: Integer;
- begin
- XMLFile := TRealICQClient.GetUserDir + OfflineAutoResponseConfigXMLFile;
- SetFileAttributes(Pchar(XMLFile), file_attribute_normal);
- XMLDocument := TXMLDocument.Create(Self);
- try
- XMLDocument.Active := True;
- if not FileExists(XMLFile) then
- begin
- CopyFile(PChar(ExtractFilePath(paramstr(0)) + ConfigXMLFilePath + OfflineAutoResponseConfigXMLFile), PChar(XMLFile), False);
- XMLDocument.Active := True;
- end;
- XMLDocument.LoadFromFile(XMLFile);
- OfflineAutoResponseConfigNode := XMLDocument.DocumentElement;
- FOfflineAutoResponseTexts.Clear;
- for iLoop := 0 to OfflineAutoResponseConfigNode.ChildNodes.Count - 1 do
- begin
- TextNode := OfflineAutoResponseConfigNode.ChildNodes[iLoop];
- FOfflineAutoResponseTexts.Add(TextNode.Text);
- end;
- finally
- XMLDocument.Free;
- end;
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.SaveOfflineAutoResponseSets;
- var
- XMLFile: string;
- XMLDocument: TXMLDocument;
- OfflineAutoResponseConfigNode: IXMLNode;
- iLoop: Integer;
- begin
- XMLFile := TRealICQClient.GetUserDir + OfflineAutoResponseConfigXMLFile;
- XMLDocument := TXMLDocument.Create(Self);
- try
- XMLDocument.Active := True;
- if not FileExists(XMLFile) then
- begin
- CopyFile(PChar(ExtractFilePath(paramstr(0)) + ConfigXMLFilePath + OfflineAutoResponseConfigXMLFile), PChar(XMLFile), False);
- XMLDocument.Active := True;
- end;
- XMLDocument.LoadFromFile(XMLFile);
- OfflineAutoResponseConfigNode := XMLDocument.DocumentElement;
- OfflineAutoResponseConfigNode.ChildNodes.Clear;
- for iLoop := 0 to FOfflineAutoResponseTexts.Count - 1 do
- begin
- OfflineAutoResponseConfigNode.AddChild('Text').Text := FOfflineAutoResponseTexts.Strings[iLoop];
- end;
- finally
- XMLDocument.SaveToFile();
- XMLDocument.Free;
- end;
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.LoadHintAndSoundConfigs;
- var
- XMLFile: string;
- XMLDocument: TXMLDocument;
- HintAndSoundConfigNode: IXMLNode;
- begin
- XMLFile := TRealICQClient.GetUserDir + HintAndSoundConfigXMLFile;
- SetFileAttributes(Pchar(XMLFile), file_attribute_normal);
- XMLDocument := TXMLDocument.Create(Self);
- try
- XMLDocument.Active := True;
- if not FileExists(XMLFile) then
- begin
- CopyFile(PChar(ExtractFilePath(paramstr(0)) + ConfigXMLFilePath + HintAndSoundConfigXMLFile), PChar(XMLFile), False);
- XMLDocument.Active := True;
- end;
- XMLDocument.LoadFromFile(XMLFile);
- HintAndSoundConfigNode := XMLDocument.DocumentElement;
- FFlashCaptionOnOnline := HintAndSoundConfigNode.ChildNodes.FindNode('FlashCaptionOnOnline').Attributes['Value'];
- FFlashCaptionOnOnline := False;
- SetFlashCaptionOnOnlineValue(FFlashCaptionOnOnline);
- FShowHintOnOnline := HintAndSoundConfigNode.ChildNodes.FindNode('ShowHintOnOnline').Attributes['Value'];
- FShowHintOnOffline := HintAndSoundConfigNode.ChildNodes.FindNode('ShowHintOnOffline').Attributes['Value'];
- FDontShowHintOnBusy := HintAndSoundConfigNode.ChildNodes.FindNode('DontShowHintOnBusy').Attributes['Value'];
- FPlaySoundOnOnline := HintAndSoundConfigNode.ChildNodes.FindNode('PlaySoundOnOnline').Attributes['Value'];
- FPlaySoundOnOffline := HintAndSoundConfigNode.ChildNodes.FindNode('PlaySoundOnOffline').Attributes['Value'];
- FPlaySoundOnGetMessage := HintAndSoundConfigNode.ChildNodes.FindNode('PlaySoundOnGetMessage').Attributes['Value'];
- FPlaySoundOnGetSystemMessage := HintAndSoundConfigNode.ChildNodes.FindNode('PlaySoundOnGetSystemMessage').Attributes['Value'];
- FFlashImageOnGetMessage := HintAndSoundConfigNode.ChildNodes.FindNode('FlashImageOnGetMessage').Attributes['Value'];
- if not Assigned(HintAndSoundConfigNode.ChildNodes.FindNode('ShowShakeWindow')) then
- begin
- HintAndSoundConfigNode.AddChild('ShowShakeWindow').Attributes['Value'] := True;
- XMLDocument.SaveToFile();
- end;
- FShowShakeWindow := HintAndSoundConfigNode.ChildNodes.FindNode('ShowShakeWindow').Attributes['Value'];
- if not Assigned(HintAndSoundConfigNode.ChildNodes.FindNode('ShowCustomMessage')) then
- begin
- HintAndSoundConfigNode.AddChild('ShowCustomMessage').Attributes['Value'] := True;
- XMLDocument.SaveToFile();
- end;
- FShowCustomMessage := HintAndSoundConfigNode.ChildNodes.FindNode('ShowCustomMessage').Attributes['Value'];
- if not Assigned(HintAndSoundConfigNode.ChildNodes.FindNode('ShowFileTransCompleted')) then
- begin
- HintAndSoundConfigNode.AddChild('ShowFileTransCompleted').Attributes['Value'] := True;
- XMLDocument.SaveToFile();
- end;
- FShowFileTransCompleted := HintAndSoundConfigNode.ChildNodes.FindNode('ShowFileTransCompleted').Attributes['Value'];
- FOnlineEventSound := HintAndSoundConfigNode.ChildNodes.FindNode('PlaySoundOnOnline').Attributes['File'];
- FOfflineEventSound := HintAndSoundConfigNode.ChildNodes.FindNode('PlaySoundOnOffline').Attributes['File'];
- FMessageEventSound := HintAndSoundConfigNode.ChildNodes.FindNode('PlaySoundOnGetMessage').Attributes['File'];
- FSystemMessageEventSound := HintAndSoundConfigNode.ChildNodes.FindNode('PlaySoundOnGetSystemMessage').Attributes['File'];
- if AnsiSameText(Copy(FOnlineEventSound, 1, 5), 'Sound') then
- FOnlineEventSound := ExtractFilePath(paramstr(0)) + FOnlineEventSound;
- if AnsiSameText(Copy(FOfflineEventSound, 1, 5), 'Sound') then
- FOfflineEventSound := ExtractFilePath(paramstr(0)) + FOfflineEventSound;
- if AnsiSameText(Copy(FMessageEventSound, 1, 5), 'Sound') then
- FMessageEventSound := ExtractFilePath(paramstr(0)) + FMessageEventSound;
- if AnsiSameText(Copy(FSystemMessageEventSound, 1, 5), 'Sound') then
- FSystemMessageEventSound := ExtractFilePath(paramstr(0)) + FSystemMessageEventSound;
- finally
- XMLDocument.Free;
- end;
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.SaveHintAndSoundConfigs;
- var
- XMLFile: string;
- XMLDocument: TXMLDocument;
- HintAndSoundConfigNode: IXMLNode;
- begin
- XMLFile := TRealICQClient.GetUserDir + HintAndSoundConfigXMLFile;
- XMLDocument := TXMLDocument.Create(Self);
- try
- XMLDocument.Active := True;
- if not FileExists(XMLFile) then
- begin
- CopyFile(PChar(ExtractFilePath(paramstr(0)) + ConfigXMLFilePath + HintAndSoundConfigXMLFile), PChar(XMLFile), False);
- XMLDocument.Active := True;
- end;
- XMLDocument.LoadFromFile(XMLFile);
- HintAndSoundConfigNode := XMLDocument.DocumentElement;
- HintAndSoundConfigNode.ChildNodes.FindNode('FlashCaptionOnOnline').Attributes['Value'] := FFlashCaptionOnOnline;
- SetFlashCaptionOnOnlineValue(FFlashCaptionOnOnline);
- HintAndSoundConfigNode.ChildNodes.FindNode('ShowHintOnOnline').Attributes['Value'] := FShowHintOnOnline;
- HintAndSoundConfigNode.ChildNodes.FindNode('ShowHintOnOffline').Attributes['Value'] := FShowHintOnOffline;
- HintAndSoundConfigNode.ChildNodes.FindNode('DontShowHintOnBusy').Attributes['Value'] := FDontShowHintOnBusy;
- HintAndSoundConfigNode.ChildNodes.FindNode('PlaySoundOnOnline').Attributes['Value'] := FPlaySoundOnOnline;
- HintAndSoundConfigNode.ChildNodes.FindNode('PlaySoundOnOffline').Attributes['Value'] := FPlaySoundOnOffline;
- HintAndSoundConfigNode.ChildNodes.FindNode('PlaySoundOnGetMessage').Attributes['Value'] := FPlaySoundOnGetMessage;
- HintAndSoundConfigNode.ChildNodes.FindNode('PlaySoundOnGetSystemMessage').Attributes['Value'] := FPlaySoundOnGetSystemMessage;
- HintAndSoundConfigNode.ChildNodes.FindNode('FlashImageOnGetMessage').Attributes['Value'] := FFlashImageOnGetMessage;
- HintAndSoundConfigNode.ChildNodes.FindNode('ShowShakeWindow').Attributes['Value'] := FShowShakeWindow;
- HintAndSoundConfigNode.ChildNodes.FindNode('ShowCustomMessage').Attributes['Value'] := FShowCustomMessage;
- HintAndSoundConfigNode.ChildNodes.FindNode('ShowFileTransCompleted').Attributes['Value'] := FShowFileTransCompleted;
- HintAndSoundConfigNode.ChildNodes.FindNode('PlaySoundOnOnline').Attributes['File'] := FOnlineEventSound;
- HintAndSoundConfigNode.ChildNodes.FindNode('PlaySoundOnOffline').Attributes['File'] := FOfflineEventSound;
- HintAndSoundConfigNode.ChildNodes.FindNode('PlaySoundOnGetMessage').Attributes['File'] := FMessageEventSound;
- HintAndSoundConfigNode.ChildNodes.FindNode('PlaySoundOnGetSystemMessage').Attributes['File'] := FSystemMessageEventSound;
- XMLDocument.SaveToFile();
- finally
- XMLDocument.Free;
- end;
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.LoadHotKeyConfigs;
- var
- XMLFile: string;
- XMLDocument: TXMLDocument;
- HotKeyConfigNode: IXMLNode;
- begin
- XMLFile := TRealICQClient.GetUserDir + HotKeyConfigXMLFile;
- SetFileAttributes(Pchar(XMLFile), file_attribute_normal);
- XMLDocument := TXMLDocument.Create(Self);
- try
- XMLDocument.Active := True;
- if not FileExists(XMLFile) then
- begin
- CopyFile(PChar(ExtractFilePath(paramstr(0)) + ConfigXMLFilePath + HotKeyConfigXMLFile), PChar(XMLFile), False);
- XMLDocument.Active := True;
- end;
- XMLDocument.LoadFromFile(XMLFile);
- HotKeyConfigNode := XMLDocument.DocumentElement;
- ReadMessageHotKey := HotKeyConfigNode.ChildNodes.FindNode('ReadMessage').Attributes['Key'];
- CopyScreenHotKey := HotKeyConfigNode.ChildNodes.FindNode('CopyScreen').Attributes['Key'];
- finally
- XMLDocument.Free;
- end;
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.SaveHotKeyConfigs;
- var
- XMLFile: string;
- XMLDocument: TXMLDocument;
- HotKeyConfigNode: IXMLNode;
- begin
- XMLFile := TRealICQClient.GetUserDir + HotKeyConfigXMLFile;
- XMLDocument := TXMLDocument.Create(Self);
- try
- XMLDocument.Active := True;
- if not FileExists(XMLFile) then
- begin
- CopyFile(PChar(ExtractFilePath(paramstr(0)) + ConfigXMLFilePath + HotKeyConfigXMLFile), PChar(XMLFile), False);
- XMLDocument.Active := True;
- end;
- XMLDocument.LoadFromFile(XMLFile);
- HotKeyConfigNode := XMLDocument.DocumentElement;
- HotKeyConfigNode.ChildNodes.FindNode('ReadMessage').Attributes['Key'] := FReadMessageHotKey;
- HotKeyConfigNode.ChildNodes.FindNode('CopyScreen').Attributes['Key'] := FCopyScreenHotKey;
- XMLDocument.SaveToFile();
- finally
- XMLDocument.Free;
- end;
- end;
- procedure TMainForm.SetCopyScreenHotKey(Value: string);
- var
- HotKeyStr: string;
- HotKey, ModKey: Cardinal;
- begin
- if FCopyScreenHotKey = Value then
- Exit;
- FCopyScreenHotKey := Value;
- if AnsiPos('+', FCopyScreenHotKey) <= 0 then
- FCopyScreenHotKey := 'CTRL+ALT+S';
- HotKeyStr := CutOffString(trim(FCopyScreenHotKey), '+');
- if AnsiPos('+', HotKeyStr) > 0 then
- HotKeyStr := CutOffString(HotKeyStr, '+');
- HotKey := Ord(PChar(UpperCase(HotKeyStr))[0]);
- if HotKeyID_CopyScreen <> 0 then
- begin
- UnregisterHotKey(Handle, HotKeyID_CopyScreen);
- DeleteAtom(HotKeyID_CopyScreen);
- end;
- if (FindAtom('FCopyScreenHotKey') = 0) and (HotKey > 0) then
- begin
- HotKeyID_CopyScreen := GlobalAddAtom(pchar('FCopyScreenHotKey')) - $C000;
- ModKey := GetModKey(FCopyScreenHotKey);
- if (not RegisterHotkey(Handle, HotKeyID_CopyScreen, ModKey, HotKey)) then
- begin
- FCanAlert := True;
- ShowNotifyAlertForm('热键 ' + FCopyScreenHotKey + ' 冲突！');
- FCanAlert := False;
- end;
- //MessageBox(Handle, PChar('热键 '+ FCopyScreenHotKey + ' 已被其它程序注册，请选择其它热键！'), '提示', MB_ICONERROR);
- end;
- SaveHotKeyConfigs;
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.SetReadMessageHotKey(Value: string);
- var
- HotKeyStr: string;
- HotKey, ModKey: Cardinal;
- begin
- if FReadMessageHotKey = Value then
- Exit;
- FReadMessageHotKey := Value;
- if AnsiPos('+', FReadMessageHotKey) <= 0 then
- FReadMessageHotKey := 'CTRL+ALT+X';
- HotKeyStr := CutOffString(trim(FReadMessageHotKey), '+');
- if AnsiPos('+', HotKeyStr) > 0 then
- HotKeyStr := CutOffString(HotKeyStr, '+');
- HotKey := Ord(PChar(UpperCase(HotKeyStr))[0]);
- if HotKeyID_ReadMessage <> 0 then
- begin
- UnregisterHotKey(Handle, HotKeyID_ReadMessage);
- DeleteAtom(HotKeyID_ReadMessage);
- end;
- if (FindAtom('FReadMessageHotKey') = 0) and (HotKey > 0) then
- begin
- HotKeyID_ReadMessage := GlobalAddAtom(pchar('FReadMessageHotKey')) - $C000;
- ModKey := GetModKey(FReadMessageHotKey);
- if (not RegisterHotkey(Handle, HotKeyID_ReadMessage, ModKey, HotKey)) then
- begin
- FCanAlert := True;
- ShowNotifyAlertForm('热键 ' + FReadMessageHotKey + ' 冲突！');
- FCanAlert := False;
- end;
- //MessageBox(Handle, PChar('热键 ' + FReadMessageHotKey + ' 已被其它程序注册，请选择其它热键！'), '提示', MB_ICONERROR);
- end;
- SaveHotKeyConfigs;
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.LoadStyleConfigs;
- var
- XMLFile: string;
- XMLDocument: TXMLDocument;
- StyleConfigNode: IXMLNode;
- iLoop: Integer;
- RealICQContacterListView: TRealICQContacterListView;
- RealICQContacterTreeView: TRealICQContacterTreeView;
- AUIMainColor: TColor;
- ALVStyle: TRealICQContacterListItemStyle;
- ALVCaptionStyle: TRealICQContacterListItemCaptionStyle;
- AShowTree: Boolean;
- ASkinName, OldSkinName: string;
- begin
- XMLFile := TRealICQClient.GetUserDir + StyleConfigXMLFile;
- SetFileAttributes(Pchar(XMLFile), file_attribute_normal);
- XMLDocument := TXMLDocument.Create(Self);
- try
- XMLDocument.Active := True;
- if not FileExists(XMLFile) then
- begin
- CopyFile(PChar(ExtractFilePath(paramstr(0)) + ConfigXMLFilePath + StyleConfigXMLFile), PChar(XMLFile), False);
- XMLDocument.Active := True;
- end;
- XMLDocument.LoadFromFile(XMLFile);
- StyleConfigNode := XMLDocument.DocumentElement;
- OldSkinName := SkinName;
- try
- ASkinName := StyleConfigNode.ChildNodes.FindNode('SkinName').Attributes['Value'];
- if ASkinName <> SkinName then
- begin
- SkinName := ASkinName;
- SaveDefaultConfigs;
- ChangeUIColor(UIMainColor);
- end;
- except
- SkinName := OldSkinName;
- end;
- AUIMainColor := StyleConfigNode.ChildNodes.FindNode('UIMainColor').Attributes['Value'];
- ChangeUIColor(FUIMainColor);
- FUIMainColor := AUIMainColor;
- SaveDefaultConfigs;
- if not Assigned(StyleConfigNode.ChildNodes.FindNode('ShowTree')) then
- begin
- StyleConfigNode.AddChild('ShowTree').Attributes['Value'] := True;
- XMLDocument.SaveToFile();
- end;
- AShowTree := StyleConfigNode.ChildNodes.FindNode('ShowTree').Attributes['Value'];
- FShowTree := AShowTree;
- actShowTree.Checked := FShowTree;
- ALVStyle := StyleConfigNode.ChildNodes.FindNode('LVStyle').Attributes['Value'];
- if (RealICQClient.WorkingMode = wmCorporation) or FShowTree then
- begin
- if ALVStyle <> lsNoHeadImage then
- ALVStyle := lsSmallHeadImage;
- end;
- if ALVStyle <> FLVStyle then
- begin
- FLVStyle := ALVStyle;
- for iLoop := 0 to FContacterListViews.Count - 1 do
- begin
- RealICQContacterListView := FContacterListViews.Objects[iLoop] as TRealICQContacterListView;
- RealICQContacterListView.Style := FLVStyle;
- end;
- for iLoop := 0 to FContacterTreeViews.Count - 1 do
- begin
- RealICQContacterTreeView := FContacterTreeViews.Objects[iLoop] as TRealICQContacterTreeView;
- RealICQContacterTreeView.Style := FLVStyle;
- end;
- end;
- ALVCaptionStyle := StyleConfigNode.ChildNodes.FindNode('LVCaptionStyle').Attributes['Value'];
- if ALVCaptionStyle <> FLVCaptionStyle then
- begin
- FLVCaptionStyle := ALVCaptionStyle;
- for iLoop := 0 to FContacterListViews.Count - 1 do
- begin
- RealICQContacterListView := FContacterListViews.Objects[iLoop] as TRealICQContacterListView;
- RealICQContacterListView.CaptionStyle := FLVCaptionStyle;
- end;
- for iLoop := 0 to FContacterTreeViews.Count - 1 do
- begin
- RealICQContacterTreeView := FContacterTreeViews.Objects[iLoop] as TRealICQContacterTreeView;
- RealICQContacterTreeView.CaptionStyle := FLVCaptionStyle;
- end;
- end;
- FShowGIFInMailForm := StyleConfigNode.ChildNodes.FindNode('ShowGIFInMailForm').Attributes['Value'];
- actShowGIFInMailForm.Checked := FShowGIFInMailForm;
- FShowGIFInTalkingForm := StyleConfigNode.ChildNodes.FindNode('ShowGIFInTalkingForm').Attributes['Value'];
- actShowGIFInTalkingForm.Checked := FShowGIFInTalkingForm;
- FShowStrangers := not StyleConfigNode.ChildNodes.FindNode('ShowStrangers').Attributes['Value'];
- if (RealICQClient.WorkingMode = wmCorporation) then
- FShowStrangers := True;
- actShowStrangers.Enabled := True;
- actShowStrangers.Execute;
- FShowBlacklists := not StyleConfigNode.ChildNodes.FindNode('ShowBlacklists').Attributes['Value'];
- if (RealICQClient.WorkingMode = wmCorporation) then
- FShowBlacklists := True;
- actShowBlacklists.Enabled := True;
- actShowBlacklists.Execute;
- FShowTeams := not StyleConfigNode.ChildNodes.FindNode('ShowTeams').Attributes['Value'];
- actShowTeams.Enabled := True;
- actShowTeams.Execute;
- FShowLatests := not StyleConfigNode.ChildNodes.FindNode('ShowLatests').Attributes['Value'];
- actShowLatests.Enabled := True;
- actShowLatests.Execute;
- FTalkingFormAlwaysOnTop := StyleConfigNode.ChildNodes.FindNode('TalkingFormAlwaysOnTop').Attributes['Value'];
- FCtrlEnterSendMessage := StyleConfigNode.ChildNodes.FindNode('CtrlEnterSendMessage').Attributes['Value'];
- if not Assigned(StyleConfigNode.ChildNodes.FindNode('CopyScreenHideTalkForm')) then
- begin
- StyleConfigNode.AddChild('CopyScreenHideTalkForm').Attributes['Value'] := False;
- XMLDocument.SaveToFile();
- end;
- FCopyScreenHideTalkForm := StyleConfigNode.ChildNodes.FindNode('CopyScreenHideTalkForm').Attributes['Value'];
- finally
- XMLDocument.Free;
- end;
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.SaveStyleConfigs;
- var
- XMLFile: string;
- XMLDocument: TXMLDocument;
- StyleConfigNode: IXMLNode;
- begin
- XMLFile := TRealICQClient.GetUserDir + StyleConfigXMLFile;
- XMLDocument := TXMLDocument.Create(Self);
- try
- XMLDocument.Active := True;
- if not FileExists(XMLFile) then
- begin
- CopyFile(PChar(ExtractFilePath(paramstr(0)) + ConfigXMLFilePath + StyleConfigXMLFile), PChar(XMLFile), False);
- XMLDocument.Active := True;
- end;
- XMLDocument.LoadFromFile(XMLFile);
- StyleConfigNode := XMLDocument.DocumentElement;
- StyleConfigNode.ChildNodes.FindNode('SkinName').Attributes['Value'] := SkinName;
- StyleConfigNode.ChildNodes.FindNode('UIMainColor').Attributes['Value'] := FUIMainColor;
- StyleConfigNode.ChildNodes.FindNode('ShowTree').Attributes['Value'] := FShowTree;
- StyleConfigNode.ChildNodes.FindNode('LVStyle').Attributes['Value'] := FLVStyle;
- StyleConfigNode.ChildNodes.FindNode('LVCaptionStyle').Attributes['Value'] := FLVCaptionStyle;
- StyleConfigNode.ChildNodes.FindNode('ShowStrangers').Attributes['Value'] := FShowStrangers;
- StyleConfigNode.ChildNodes.FindNode('ShowBlacklists').Attributes['Value'] := FShowBlacklists;
- StyleConfigNode.ChildNodes.FindNode('ShowTeams').Attributes['Value'] := FShowTeams;
- StyleConfigNode.ChildNodes.FindNode('ShowLatests').Attributes['Value'] := FShowLatests;
- StyleConfigNode.ChildNodes.FindNode('ShowGIFInMailForm').Attributes['Value'] := FShowGIFInMailForm;
- StyleConfigNode.ChildNodes.FindNode('ShowGIFInTalkingForm').Attributes['Value'] := FShowGIFInTalkingForm;
- StyleConfigNode.ChildNodes.FindNode('TalkingFormAlwaysOnTop').Attributes['Value'] := FTalkingFormAlwaysOnTop;
- StyleConfigNode.ChildNodes.FindNode('CtrlEnterSendMessage').Attributes['Value'] := FCtrlEnterSendMessage;
- StyleConfigNode.ChildNodes.FindNode('CopyScreenHideTalkForm').Attributes['Value'] := FCopyScreenHideTalkForm;
- XMLDocument.SaveToFile();
- finally
- XMLDocument.Free;
- end;
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.LoadAutoUpdateConfigs;
- var
- XMLFile: string;
- XMLDocument: TXMLDocument;
- AutoUpdateConfigNode: IXMLNode;
- begin
- XMLFile := ExtractFilePath(paramstr(0)) + ConfigXMLFilePath + AutoUpdateConfigXMLFile;
- SetFileAttributes(Pchar(XMLFile), file_attribute_normal);
- XMLDocument := TXMLDocument.Create(Self);
- try
- XMLDocument.Active := True;
- XMLDocument.LoadFromFile(XMLFile);
- AutoUpdateConfigNode := XMLDocument.DocumentElement;
- FAutoUpdate := AutoUpdateConfigNode.ChildNodes.FindNode('AutoUpdate').Attributes['Value'];
- finally
- XMLDocument.Free;
- end;
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.SaveAutoUpdateConfigs;
- var
- XMLFile: string;
- XMLDocument: TXMLDocument;
- AutoUpdateConfigNode: IXMLNode;
- begin
- XMLFile := ExtractFilePath(paramstr(0)) + ConfigXMLFilePath + AutoUpdateConfigXMLFile;
- XMLDocument := TXMLDocument.Create(Self);
- try
- XMLDocument.Active := True;
- XMLDocument.LoadFromFile(XMLFile);
- AutoUpdateConfigNode := XMLDocument.DocumentElement;
- AutoUpdateConfigNode.ChildNodes.FindNode('AutoUpdate').Attributes['Value'] := FAutoUpdate;
- XMLDocument.SaveToFile();
- finally
- XMLDocument.Free;
- end;
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.LoadDefaultConfigs;
- var
- XMLFile: string;
- XMLDocument: TXMLDocument;
- DefaultConfigNode: IXMLNode;
- OldSkinName: string;
- BaseTop, BaseLeft: Integer;
- begin
- BaseTop := (Height - ClientHeight) div 2;
- BaseLeft := (Width - ClientWidth) div 2;
- XMLFile := ExtractFilePath(paramstr(0)) + ConfigXMLFilePath + DefaultConfigXMLFile;
- SetFileAttributes(Pchar(XMLFile), file_attribute_normal);
- XMLDocument := TXMLDocument.Create(Self);
- try
- XMLDocument.Active := True;
- XMLDocument.LoadFromFile(XMLFile);
- DefaultConfigNode := XMLDocument.DocumentElement;
- FUIMainColor := DefaultConfigNode.ChildNodes.FindNode('UIMainColor').Attributes['Value'];
- OldSkinName := SkinName;
- try
- SkinName := DefaultConfigNode.ChildNodes.FindNode('SkinName').Attributes['Value'];
- except
- SkinName := OldSkinName;
- end;
- FShowMainFormOnStart := DefaultConfigNode.ChildNodes.FindNode('ShowMainFormOnStart').Attributes['Value'];
- FMainFormLeft := DefaultConfigNode.ChildNodes.FindNode('MainFormLeft').Attributes['Value'];
- FMainFormTop := DefaultConfigNode.ChildNodes.FindNode('MainFormTop').Attributes['Value'];
- FMainFormWidth := DefaultConfigNode.ChildNodes.FindNode('MainFormWidth').Attributes['Value'];
- FMainFormHeight := DefaultConfigNode.ChildNodes.FindNode('MainFormHeight').Attributes['Value'];
- FTalkingFormLeft := DefaultConfigNode.ChildNodes.FindNode('TalkingFormLeft').Attributes['Value'];
- FTalkingFormTop := DefaultConfigNode.ChildNodes.FindNode('TalkingFormTop').Attributes['Value'];
- FTalkingFormWidth := DefaultConfigNode.ChildNodes.FindNode('TalkingFormWidth').Attributes['Value'];
- FTalkingFormHeight := DefaultConfigNode.ChildNodes.FindNode('TalkingFormHeight').Attributes['Value'];
- if not Assigned(DefaultConfigNode.ChildNodes.FindNode('TalkingRightWidth')) then
- begin
- DefaultConfigNode.AddChild('TalkingRightWidth').Attributes['Value'] := 0;
- XMLDocument.SaveToFile();
- end;
- FTalkingRightWidth := DefaultConfigNode.ChildNodes.FindNode('TalkingRightWidth').Attributes['Value'];
- if not Assigned(DefaultConfigNode.ChildNodes.FindNode('SMSFormLeft')) then
- begin
- DefaultConfigNode.AddChild('SMSFormLeft').Attributes['Value'] := -1;
- XMLDocument.SaveToFile();
- end;
- FSMSFormLeft := DefaultConfigNode.ChildNodes.FindNode('SMSFormLeft').Attributes['Value'];
- if not Assigned(DefaultConfigNode.ChildNodes.FindNode('SMSFormTop')) then
- begin
- DefaultConfigNode.AddChild('SMSFormTop').Attributes['Value'] := -1;
- XMLDocument.SaveToFile();
- end;
- FSMSFormTop := DefaultConfigNode.ChildNodes.FindNode('SMSFormTop').Attributes['Value'];
- if not Assigned(DefaultConfigNode.ChildNodes.FindNode('SMSFormWidth')) then
- begin
- DefaultConfigNode.AddChild('SMSFormWidth').Attributes['Value'] := -1;
- XMLDocument.SaveToFile();
- end;
- FSMSFormWidth := DefaultConfigNode.ChildNodes.FindNode('SMSFormWidth').Attributes['Value'];
- if not Assigned(DefaultConfigNode.ChildNodes.FindNode('SMSFormHeight')) then
- begin
- DefaultConfigNode.AddChild('SMSFormHeight').Attributes['Value'] := -1;
- XMLDocument.SaveToFile();
- end;
- FSMSFormHeight := DefaultConfigNode.ChildNodes.FindNode('SMSFormHeight').Attributes['Value'];
- if FMainFormHeight <= 0 then
- FMainFormHeight := Round(Screen.WorkAreaHeight * 0.8);
- if FMainFormWidth <= 0 then
- FMainFormWidth := 258;
- if (FMainFormLeft + FMainFormWidth - BaseLeft < 2) then
- FMainFormLeft := 0;
- if (FMainFormLeft - BaseLeft > Screen.WorkAreaWidth - 2) then
- FMainFormLeft := Screen.WorkAreaWidth - FMainFormWidth;
- if (FMainFormTop + FMainFormHeight - BaseTop < 2) then
- FMainFormTop := 0;
- if (FMainFormTop > Screen.WorkAreaHeight) then
- FMainFormTop := 0;
- if FTalkingFormHeight <= 0 then
- FTalkingFormHeight := Round(Screen.WorkAreaHeight * 0.6);
- if FTalkingFormWidth <= 0 then
- FTalkingFormWidth := Round(Screen.WorkAreaWidth * 0.6);
- if (FTalkingFormLeft < 0) or (FTalkingFormLeft > Screen.WorkAreaWidth) then
- FTalkingFormLeft := (Screen.WorkAreaWidth - FTalkingFormWidth) div 2;
- if (FTalkingFormTop < 0) or (FTalkingFormTop > Screen.WorkAreaHeight) then
- FTalkingFormTop := (Screen.WorkAreaHeight - FTalkingFormHeight) div 2;
- if FSMSFormHeight <= 0 then
- FSMSFormHeight := 410;
- if FSMSFormWidth <= 0 then
- FSMSFormWidth := 460;
- if (FSMSFormLeft < 0) or (FSMSFormLeft > Screen.WorkAreaWidth) then
- FSMSFormLeft := (Screen.WorkAreaWidth - FSMSFormWidth) div 2;
- if (FSMSFormTop < 0) or (FSMSFormTop > Screen.WorkAreaHeight) then
- FSMSFormTop := (Screen.WorkAreaHeight - FSMSFormHeight) div 2;
- Left := FMainFormLeft;
- Top := FMainFormTop;
- Width := FMainFormWidth;
- Height := FMainFormHeight;
- FAlwaysOnTop := DefaultConfigNode.ChildNodes.FindNode('AlwaysOnTop').Attributes['Value'];
- actAlwaysOnTop.Enabled := True;
- actAlwaysOnTop.Execute;
- if not Assigned(DefaultConfigNode.ChildNodes.FindNode('AutoHideMainForm')) then
- begin
- DefaultConfigNode.AddChild('AutoHideMainForm').Attributes['Value'] := True;
- XMLDocument.SaveToFile();
- end;
- FAutoHide := DefaultConfigNode.ChildNodes.FindNode('AutoHideMainForm').Attributes['Value'];
- CheckWindowPositon;
- if not Assigned(DefaultConfigNode.ChildNodes.FindNode('AutoShowRequestMessage')) then
- begin
- DefaultConfigNode.AddChild('AutoShowRequestMessage').Attributes['Value'] := False;
- XMLDocument.SaveToFile();
- end;
- FAutoShowRequestMessage := DefaultConfigNode.ChildNodes.FindNode('AutoShowRequestMessage').Attributes['Value'];
- if not Assigned(DefaultConfigNode.ChildNodes.FindNode('ConfirmSendOfflineFile')) then
- begin
- DefaultConfigNode.AddChild('ConfirmSendOfflineFile').Attributes['Value'] := True;
- XMLDocument.SaveToFile();
- end;
- FConfirmSendOfflineFile := DefaultConfigNode.ChildNodes.FindNode('ConfirmSendOfflineFile').Attributes['Value'];
- if not Assigned(DefaultConfigNode.ChildNodes.FindNode('AppEnable')) then
- begin
- DefaultConfigNode.AddChild('AppEnable').Attributes['Value'] := False;
- XMLDocument.SaveToFile();
- end;
- ImgApp.Visible := DefaultConfigNode.ChildNodes.FindNode('AppEnable').Attributes['Value'];
- if not Assigned(DefaultConfigNode.ChildNodes.FindNode('NewConsole')) then
- begin
- DefaultConfigNode.AddChild('NewConsole').Attributes['Value'] := True;
- XMLDocument.SaveToFile();
- end;
- FNewConsole := DefaultConfigNode.ChildNodes.FindNode('NewConsole').Attributes['Value'];
- if not Assigned(DefaultConfigNode.ChildNodes.FindNode('CaEnable')) then
- begin
- DefaultConfigNode.AddChild('CaEnable').Attributes['Value'] := False;
- XMLDocument.SaveToFile();
- end;
- RealICQClient.CaEnable := DefaultConfigNode.ChildNodes.FindNode('CaEnable').Attributes['Value'];
- btnCALogin.Visible := RealICQClient.CaEnable;
- finally
- XMLDocument.Free;
- end;
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.SaveDefaultConfigs;
- var
- XMLFile: string;
- XMLDocument: TXMLDocument;
- DefaultConfigNode: IXMLNode;
- begin
- XMLFile := ExtractFilePath(paramstr(0)) + ConfigXMLFilePath + DefaultConfigXMLFile;
- XMLDocument := TXMLDocument.Create(Self);
- try
- XMLDocument.Active := True;
- XMLDocument.LoadFromFile(XMLFile);
- DefaultConfigNode := XMLDocument.DocumentElement;
- DefaultConfigNode.ChildNodes.FindNode('SkinName').Attributes['Value'] := SkinName;
- DefaultConfigNode.ChildNodes.FindNode('UIMainColor').Attributes['Value'] := FUIMainColor;
- DefaultConfigNode.ChildNodes.FindNode('AlwaysOnTop').Attributes['Value'] := FAlwaysOnTop;
- DefaultConfigNode.ChildNodes.FindNode('AutoHideMainForm').Attributes['Value'] := FAutoHide;
- DefaultConfigNode.ChildNodes.FindNode('AutoShowRequestMessage').Attributes['Value'] := FAutoShowRequestMessage;
- DefaultConfigNode.ChildNodes.FindNode('ShowMainFormOnStart').Attributes['Value'] := FShowMainFormOnStart;
- try
- DefaultConfigNode.ChildNodes.FindNode('ConfirmSendOfflineFile').Attributes['Value'] := FConfirmSendOfflineFile;
- except
- end;
- DefaultConfigNode.ChildNodes.FindNode('MainFormLeft').Attributes['Value'] := FMainFormLeft;
- DefaultConfigNode.ChildNodes.FindNode('MainFormTop').Attributes['Value'] := FMainFormTop;
- DefaultConfigNode.ChildNodes.FindNode('MainFormWidth').Attributes['Value'] := FMainFormWidth;
- DefaultConfigNode.ChildNodes.FindNode('MainFormHeight').Attributes['Value'] := FMainFormHeight;
- DefaultConfigNode.ChildNodes.FindNode('TalkingFormLeft').Attributes['Value'] := FTalkingFormLeft;
- DefaultConfigNode.ChildNodes.FindNode('TalkingFormTop').Attributes['Value'] := FTalkingFormTop;
- DefaultConfigNode.ChildNodes.FindNode('TalkingFormWidth').Attributes['Value'] := FTalkingFormWidth;
- DefaultConfigNode.ChildNodes.FindNode('TalkingFormHeight').Attributes['Value'] := FTalkingFormHeight;
- DefaultConfigNode.ChildNodes.FindNode('TalkingRightWidth').Attributes['Value'] := FTalkingRightWidth;
- DefaultConfigNode.ChildNodes.FindNode('SMSFormLeft').Attributes['Value'] := FSMSFormLeft;
- DefaultConfigNode.ChildNodes.FindNode('SMSFormTop').Attributes['Value'] := FSMSFormTop;
- DefaultConfigNode.ChildNodes.FindNode('SMSFormWidth').Attributes['Value'] := FSMSFormWidth;
- DefaultConfigNode.ChildNodes.FindNode('SMSFormHeight').Attributes['Value'] := FSMSFormHeight;
- XMLDocument.SaveToFile();
- finally
- XMLDocument.Free;
- end;
- end;
- //------------------------------------------------------------------------------
- //procedure TMainForm.LoadGroupConfig;
- //var
- // XMLDocument: TXMLDocument;
- // ServerConfigNode: IXMLNode;
- //begin
- // XMLDocument := TXMLDocument.Create(Self);
- // try
- // XMLDocument.Active := True;
- //
- // if csDesigning in ComponentState then
- // exit;
- // XMLDocument.LoadFromFile(ExtractFilePath(Application.ExeName) + ConfigXMLFilePath + 'GroupServerConfig.xml');
- //
- // ServerConfigNode := XMLDocument.DocumentElement;
- //
- // FGroupAddress := ServerConfigNode.ChildNodes.FindNode('GroupServer').Attributes['Address'];
- // FGroupPort := ServerConfigNode.ChildNodes.FindNode('GroupServer').Attributes['Port'];
- // FGroupImagePort := ServerConfigNode.ChildNodes.FindNode('GroupServer').Attributes['ImagePort'];
- // FGroupShareAddress := ServerConfigNode.ChildNodes.FindNode('GroupShareServer').Attributes['Address'];
- // FGroupSharePort := ServerConfigNode.ChildNodes.FindNode('GroupShareServer').Attributes['Port'];
- // except
- // on E: Exception do
- // begin
- // Error(E.Message, 'TMainForm.LoadGroupConfig');
- // XMLDocument.Free;
- // end;
- // end;
- // XMLDocument.Free;
- //end;
- procedure TMainForm.LoadGroupConfigs;
- var
- XMLFile: string;
- XMLDocument: TXMLDocument;
- GroupConfigNode, GroupListNode, GroupNode: IXMLNode;
- GroupMembers: TStringList;
- iLoop, jLoop: Integer;
- begin
- XMLFile := TRealICQClient.GetUserDir + GroupConfigXMLFile;
- SetFileAttributes(Pchar(XMLFile), file_attribute_normal);
- XMLDocument := TXMLDocument.Create(Self);
- try
- XMLDocument.Active := True;
- if not FileExists(XMLFile) then
- begin
- CopyFile(PChar(ExtractFilePath(paramstr(0)) + ConfigXMLFilePath + GroupConfigXMLFile), PChar(XMLFile), False);
- XMLDocument.Active := True;
- end;
- XMLDocument.LoadFromFile(XMLFile);
- GroupConfigNode := XMLDocument.DocumentElement;
- FShowGroup := GroupConfigNode.ChildNodes.FindNode('ShowGroup').Attributes['Value'];
- actShowGroup.Checked := FShowGroup;
- GroupListNode := GroupConfigNode.ChildNodes.FindNode('Groups');
- FGroups.Clear;
- for iLoop := 0 to GroupListNode.ChildNodes.Count - 1 do
- begin
- GroupNode := GroupListNode.ChildNodes[iLoop];
- GroupMembers := TStringList.Create;
- for jLoop := 0 to GroupNode.ChildNodes.Count - 1 do
- begin
- GroupMembers.Add(GroupNode.ChildNodes[jLoop].Text);
- end;
- FGroups.InsertObject(GroupNode.Attributes['Position'], GroupNode.Attributes['Name'], GroupMembers);
- end;
- except
- on E: Exception do
- begin
- Error(E.Message, 'TMainForm.LoadGroupConfigs');
- XMLDocument.Free;
- end;
- end;
- XMLDocument.Free;
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.miMoveToStrangersClick(Sender: TObject);
- {var
- GroupIndex, iLoop: Integer;
- GroupName: String;
- ListView: TRealICQContacterListView;
- ListItem: TRealICQContacterListItem;
- ItemIndex: Integer;
- RealICQContacterTreeView: TRealICQContacterTreeView;
- Employee: TRealICQEmployee; }
- begin
- { if MessageBox(Handle,
- '确实要将选中的用户移至陌生人中吗？',
- '确认',
- MB_OKCANCEL or MB_ICONQUESTION) <> IDOK then Exit;
- GroupName :='陌生人';// navForContacters.Groups[navForContacters.ActiveGroupIndex];
- if (GroupName = lvStrangers)then exit;
- if GroupName = LVMyContacters then
- begin
- ItemIndex := FContacterTreeViews.IndexOf(LVMyContacters);
- RealICQContacterTreeView := FContacterTreeViews.Objects[ItemIndex] as TRealICQContacterTreeView;
- Employee := RealICQContacterTreeView.GetSelectedEmployee;
- RealICQClient.MoveToStrangers(Employee.LoginName);
- Exit;
- end;
- GroupIndex := FContacterListViews.IndexOf(GroupName);
- ListView := FContacterListViews.Objects[GroupIndex] as TRealICQContacterListView;
- ListView.DisableAlign;
- try
- for iLoop := ListView.Items.Count - 1 downto 0 do
- begin
- ListItem := ListView.Items.Objects[iLoop] as TRealICQContacterListItem;
- if ListItem.Selected then
- begin
- RealICQClient.MoveToStrangers(ListItem.LoginName);
- Sleep(15);
- end;
- end;
- finally
- ListView.EnableAlign;
- end;
- }
- end;
- procedure TMainForm.miMuteClick(Sender: TObject);
- begin
- FLoginState := stMute;
- FLeaveMessage := '勿扰';
- SetLoginStateControlState;
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.miOnlineClick(Sender: TObject);
- begin
- FLoginState := stOnline;
- FLeaveMessage := '';
- SetLoginStateControlState;
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.miOtherStateClick(Sender: TObject);
- var
- LeaveMessage: string;
- begin
- LeaveMessage := Trim(ShowMyInputBox('其它状态', '请输入离开状态说明文字', '', 16));
- if Length(LeaveMessage) > 0 then
- begin
- FLoginState := stLeave;
- FLeaveMessage := LeaveMessage;
- SetLoginStateControlState;
- end;
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.miMoveToBlacklistsClick(Sender: TObject);
- var
- GroupName: string;
- TreeView: TRealICQContacterTreeView;
- ItemIndex: Integer;
- Friend: TRealICQEmployee;
- Black: TRealICQEmployee;
- begin
- if MessageBox(Handle, '确实要将选中的用户移至黑名单吗？', '确认', MB_OKCANCEL or MB_ICONQUESTION) <> IDOK then
- Exit;
- ItemIndex := FContacterTreeViews.IndexOf(LVFriends);
- TreeView := FContacterTreeViews.Objects[ItemIndex] as TRealICQContacterTreeView;
- Friend := TreeView.GetSelectedEmployee;
- if Friend = nil then
- Exit;
- Black := TRealICQEmployee.Create(Friend.LoginName);
- Black.BranchID := LvBlackLists;
- Black.DisplayName := Friend.DisplayName;
- GroupName := Friend.BranchID;
- if (GroupName = lvBlacklists) then
- exit;
- if GroupName = LvFriends then
- begin
- RealICQClient.DelFriend(Friend.LoginName);
- RealICQClient.MoveToBlacklists(Friend.LoginName);
- TreeView.AddEmployee(Black);
- end;
- end;
- procedure TMainForm.miSkinClick(Sender: TObject);
- var
- OldSkin: string;
- begin
- OldSkin := SkinName;
- try
- SkinName := (Sender as TMenuItem).Caption;
- ChangeAddFriendFormSkin(SkinName);
- ChangeAddFriendRequestFormSkin(SkinName);
- ChangeTalkingFormSkin(SkinName);
- ChangeSMSFormSkin(SkinName);
- ChangeSeeUserInformationFormsSkin(SkinName);
- ChangeSystemMessageFormsSkin(SkinName);
-
ChangeTeamOptionsFormSkin(SkinName);
- if VideoForm <> nil then
- begin
- VideoForm.SkinName := SkinName;
- VideoForm.ChangeUIColor(VideoForm.TalkingForm.WindowColor);
- end;
- if CreateTeamForm <> nil then
- begin
- CreateTeamForm.SkinName := SkinName;
- CreateTeamForm.ChangeUIColor(UIMainColor);
- end;
- if SearchForm <> nil then
- begin
- SearchForm.SkinName := SkinName;
- SearchForm.ChangeUIColor(UIMainColor);
- end;
- if SearchTeamForm <> nil then
- begin
- SearchTeamForm.SkinName := SkinName;
- SearchTeamForm.ChangeUIColor(UIMainColor);
- end;
- if CustomFacesManagerForm <> nil then
- begin
- CustomFacesManagerForm.SkinName := SkinName;
- CustomFacesManagerForm.ChangeUIColor(UIMainColor);
- end;
- if VCardForm <> nil then
- begin
- VCardForm.SkinName := SkinName;
- VCardForm.ChangeUIColor(UIMainColor);
- end;
- except
- MessageBox(Handle, '加载界面时出错！', '错误', MB_ICONERROR);
- SkinName := OldSkin;
- end;
- ChangeUIColor(UIMainColor);
- PostMessage(Handle, WM_SIZE, 0, 0);
- if RealICQClient.Logined and RealICQClient.Connected then
- SaveStyleConfigs;
- SaveDefaultConfigs;
- end;
- //----------------------------------------------------
- procedure TMainForm.ImageButtonMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
- begin
- FHintWindow.ReleaseHandle;
- FHintWindow.Visible := False;
- SetToolBarState(Sender);
- end;
- procedure TMainForm.tsContactersResize(Sender: TObject);
- begin
- { TODO -olqq -c : 注释 2015/1/22 15:30:11 }
- // ScrollBoxContacters.Width := pnlGroups.Width;
- // PnlMoreUser.Width := pnlGroups.Width;
- // ScrollBoxMyFriend.Width := pnlGroups.Width;
- // ScrollBoxTeam.Width := pnlGroups.Width;
- // ScrollBoxLatests.Width := pnlGroups.Width;
- // ScrollBoxContacters.Height := pnlGroups.Height;
- // PnlMoreUser.Height := pnlGroups.Height;
- // ScrollBoxMyFriend.Height := pnlGroups.Height;
- // ScrollBoxTeam.Height := pnlGroups.Height;
- // ScrollBoxLatests.Height := pnlGroups.Height;
- {ScrollBoxContacters.Left := 0;
- PnlMoreUser.Left := ScrollBoxContacters.Left + ScrollBoxContacters.Width;
- ScrollBoxMyFriend.Left := PnlMoreUser.Left + PnlMoreUser.Width;
- ScrollBoxTeam.Left := ScrollBoxMyFriend.Left + ScrollBoxMyFriend.Width;
- ScrollBoxLatests.Left := ScrollBoxTeam.Left + ScrollBoxTeam.Width;}
- end;
- procedure TMainForm.tsContactersShow(Sender: TObject);
- begin
- {ScrollBoxContacters.Visible := True;
- PnlMoreUser.Visible := True;
- ScrollBoxMyFriend.Visible := True;
- ScrollBoxTeam.Visible := True;
- ScrollBoxLatests.Visible := True;}
- { TODO -olqq -c : 注释 2015/1/22 15:33:36 }
- // ScrollBoxContacters.Align := alNone;
- // PnlMoreUser.Align := alNone;
- // ScrollBoxMyFriend.Align := alNone;
- // ScrollBoxTeam.Align := alNone;
- // ScrollBoxLatests.Align := alNone;
- // ScrollBoxContacters.Top := 0;
- // PnlMoreUser.Top := 0;
- // ScrollBoxMyFriend.Top := 0;
- // ScrollBoxTeam.Top := 0;
- // ScrollBoxLatests.Top := 0;
- tsContactersResize(tsContacters);
- end;
- //-----------------------------------------------------
- procedure TMainForm.SetToolBarState(Sender: TObject);
- var
- ImageButton: TRealICQHoverImage;
- TmpImageButton: TRealICQHoverImage;
- TmpImageButtonIcon: TRealICQHoverImage;
- iLoop: Integer;
- OldControl, NewControl: TWinControl;
- ItemIndex, divSize: Integer;
- RealICQContacterTreeView: TRealICQContacterTreeView;
- begin
- ImageButton := FToolBarButtonList.Objects[(Sender as TRealICQHoverImage).Tag - 1] as TRealICQHoverImage;
- OldControl := nil;
- if ScrollBoxContacters.Visible then
- OldControl := ScrollBoxContacters;
- if PnlMoreUser.Visible then
- OldControl := PnlMoreUser;
- if ScrollBoxMyFriend.Visible then
- OldControl := ScrollBoxMyFriend;
- if ScrollBoxTeam.Visible then
- OldControl := ScrollBoxTeam;
- if ScrollBoxLatests.Visible then
- OldControl := ScrollBoxLatests;
- {if ImageButton.Tag = 2 then
- begin
- if ScrollBoxMoreUser.Tag = 0 then
- begin
- ScrollBoxMoreUser.Tag := 1;
- end;
- end; }
- NewControl := nil;
- if ImageButton.Tag = 1 then
- NewControl := ScrollBoxContacters;
- if ImageButton.Tag = 2 then
- NewControl := PnlMoreUser;
- if ImageButton.Tag = 3 then
- NewControl := ScrollBoxMyFriend;
- if ImageButton.Tag = 4 then
- NewControl := ScrollBoxTeam;
- if ImageButton.Tag = 5 then
- NewControl := ScrollBoxLatests;
- if False and (OldControl <> nil) then
- begin
- ItemIndex := FContacterTreeViews.IndexOf(LVMyContacters);
- RealICQContacterTreeView := FContacterTreeViews.Objects[ItemIndex] as TRealICQContacterTreeView;
- RealICQContacterTreeView.HideScroll;
- RealICQContacterTreeView.ReDrawAll;
- RealICQContacterTreeView.BeginUpdate;
- ItemIndex := FContacterTreeViews.IndexOf(LVMoreUsers);
- RealICQContacterTreeView := FContacterTreeViews.Objects[ItemIndex] as TRealICQContacterTreeView;
- RealICQContacterTreeView.HideScroll;
- RealICQContacterTreeView.ReDrawAll;
- RealICQContacterTreeView.BeginUpdate;
- Application.ProcessMessages;
- //Exit;
- NewControl.DisableAlign;
- NewControl.Enabled := False;
- OldControl.DisableAlign;
- OldControl.Enabled := False;
- divSize := pnlGroups.Width div 10;
- try
- if OldControl.Tag < NewControl.Tag then
- begin
- NewControl.Left := OldControl.Left + OldControl.Width;
- NewControl.Visible := True;
- while NewControl.Left > 0 do
- begin
- if NewControl.Left - divSize < 0 then
- begin
- NewControl.Left := 0;
- end
- else
- begin
- OldControl.Left := OldControl.Left - divSize;
- NewControl.Left := NewControl.Left - divSize;
- end;
- Application.ProcessMessages;
- Sleep(10);
- end;
- OldControl.Visible := False;
- end
- else
- begin
- NewControl.Left := OldControl.Left - OldControl.Width;
- NewControl.Visible := True;
- while NewControl.Left < 0 do
- begin
- if NewControl.Left + divSize > 0 then
- begin
- NewControl.Left := 0;
- end
- else
- begin
- OldControl.Left := OldControl.Left + divSize;
- NewControl.Left := NewControl.Left + divSize;
- end;
- Application.ProcessMessages;
- Sleep(10);
- end;
- OldControl.Visible := False;
- end;
- finally
- ItemIndex := FContacterTreeViews.IndexOf(LVMyContacters);
- RealICQContacterTreeView := FContacterTreeViews.Objects[ItemIndex] as TRealICQContacterTreeView;
- RealICQContacterTreeView.EndUpdate;
- ItemIndex := FContacterTreeViews.IndexOf(LVMoreUsers);
- RealICQContacterTreeView := FContacterTreeViews.Objects[ItemIndex] as TRealICQContacterTreeView;
- RealICQContacterTreeView.EndUpdate;
- NewControl.EnableAlign;
- NewControl.Enabled := True;
- OldControl.EnableAlign;
- OldControl.Enabled := True;
- end;
- end
- else
- begin
- if OldControl <> nil then
- OldControl.Visible := False;
- NewControl.Left := 0;
- NewControl.Visible := True;
- end;
- pnlTeams.Visible := ImageButton.Tag = 4;
- if pnlTeams.Visible then
- pnlTeams.Height := 22
- else
- pnlTeams.Height := 0;
- {ScrollBoxContacters.Visible := ImageButton.Tag = 1;
- PnlMoreUser.Visible := ImageButton.Tag = 2;
- ScrollBoxMyFriend.Visible := ImageButton.Tag = 3;
- ScrollBoxTeam.Visible := ImageButton.Tag = 4;
- pnlTeams.Visible := ImageButton.Tag = 4;
- if pnlTeams.Visible then
- pnlTeams.Height := 22
- else
- pnlTeams.Height := 0;
- ScrollBoxLatests.Visible := ImageButton.Tag = 5; }
- ActiveButtonTag := ImageButton.Tag;
- for iLoop := 0 to FToolBarButtonList.Count - 1 do
- begin
- TmpImageButton := FToolBarButtonList.Objects[iLoop] as TRealICQHoverImage;
- TmpImageButtonIcon := FToolBarButtonIconList.Objects[iLoop] as TRealICQHoverImage;
- if TmpImageButton.Tag = ImageButton.Tag then
- begin
- TmpImageButton.Picture.LoadFromFile(ExtractFilePath(Application.ExeName) + 'Images\menu\01_On.bmp');
- TmpImageButton.OnMouseUp := nil;
- TmpImageButton.OnMouseEnter := nil;
- TmpImageButton.OnMouseLeave := nil;
- TmpImageButtonIcon.OnMouseUp := nil;
- TmpImageButtonIcon.OnMouseEnter := nil;
- TmpImageButtonIcon.OnMouseLeave := nil;
- end
- else
- begin
- TmpImageButton.Picture.LoadFromFile(ExtractFilePath(Application.ExeName) + 'Images\menu\01_Off.bmp');
- TmpImageButton.OnMouseUp := ImageButtonMouseUp;
- TmpImageButton.OnMouseEnter := ImageButtonEnter;
- TmpImageButton.OnMouseLeave := ImageButtonLeave;
- TmpImageButtonIcon.OnMouseUp := ImageButtonMouseUp;
- TmpImageButtonIcon.OnMouseEnter := ImageButtonEnter;
- TmpImageButtonIcon.OnMouseLeave := ImageButtonLeave;
- end;
- ConvertBitmapToColor(TmpImageButton.Picture.Bitmap, UIMainColor);
- end;
- end;
- //----------------------------
- procedure TMainForm.ImageButtonEnter(Sender: TObject);
- var
- ImageButton: TRealICQHoverImage;
- ImagePath: string;
- procedure OpenHint(HintStr: string);
- var
- TextWidth, TextHeight: Integer;
- rect: TRect;
- begin
- TextWidth := FHintWindow.Canvas.TextWidth(HintStr);
- TextHeight := FHintWindow.Canvas.TextHeight(HintStr);
- rect.Left := Mouse.CursorPos.X;
- rect.Top := Mouse.CursorPos.Y + 20;
- rect.Right := rect.Left + TextWidth + 5;
- rect.Bottom := rect.Top + TextHeight;
- FHintWindow.Color := clInfoBk;
- FHintWindow.ActivateHint(Rect, HintStr);
- FHintWindow.Visible := True;
- end;
- begin
- ImageButton := FToolBarButtonList.Objects[(Sender as TRealICQHoverImage).Tag - 1] as TRealICQHoverImage;
- ImagePath := ExtractFilePath(Application.ExeName) + 'Images\menu\01_Over.bmp';
- ImageButton.Picture.LoadFromFile(ImagePath);
- ConvertBitmapToColor(ImageButton.Picture.Bitmap, UIMainColor);
- OpenHint(FToolBarButtonList[ImageButton.Tag - 1]);
- end;
- //-----------------------------
- procedure TMainForm.ImageButtonLeave(Sender: TObject);
- var
- ImageButton: TRealICQHoverImage;
- ImagePath: string;
- begin
- ImageButton := FToolBarButtonList.Objects[(Sender as TRealICQHoverImage).Tag - 1] as TRealICQHoverImage;
- ImagePath := ExtractFilePath(Application.ExeName) + 'Images\menu\01_Off.bmp';
- ImageButton.Picture.LoadFromFile(ImagePath);
- ConvertBitmapToColor(ImageButton.Picture.Bitmap, UIMainColor);
- FHintWindow.ReleaseHandle;
- FHintWindow.Visible := False;
- end;
- procedure TMainForm.miChangeLoginNameClick(Sender: TObject);
- var
- LoginUser: TLoginUser;
- begin
- try
- LoginUser := RealICQClient.LoginedUsers.Objects[(Sender as TMenuItem).Tag] as TLoginUser;
- edPassword.Text := '';
- edLoginName.Text := LoginUser.LoginName;
- if (LoginUser.Password <> '') and (LoginUser.LoginName <> '') then
- begin
- edPassword.Text := RealICQClient.DecyptPassword(LoginUser.Password);
- FSavePassword := True;
- self.ImgLstCheckStates.GetIcon(1, spbSavePassword.Icon);
- end;
- self.lblRemoveMyLoginInfo.Visible := True;
- except
- edLoginName.Text := '';
- end;
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.miClearLoginHistoryClick(Sender: TObject);
- var
- ClearAll: Boolean;
- begin
- ClearAll := True;
- if UpperCase(Sender.ClassName) = UpperCase('TLabel') then
- ClearAll := False;
- MainForm.RealICQClient.ClearLoginHistory(ClearAll, edLoginName.Text);
- edLoginName.Text := '';
- edPassword.Text := '';
- actLoginAs.Visible := False;
- SetLoginControlsVisible(True);
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.miColorClick(Sender: TObject);
- begin
- FUIMainColor := (Sender as TMenuItem).Tag;
- ChangeUIColor((Sender as TMenuItem).Tag);
- if RealICQClient.Logined and RealICQClient.Connected then
- SaveStyleConfigs;
- SaveDefaultConfigs;
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.miHiddenClick(Sender: TObject);
- begin
- FLoginState := stHidden;
- FLeaveMessage := '';
- SetLoginStateControlState;
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.miMeetingClick(Sender: TObject);
- begin
- FLoginState := stLeave;
- FLeaveMessage := (Sender as TMenuItem).Caption;
- SetLoginStateControlState;
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.miMoreColorsClick(Sender: TObject);
- begin
- ColorDialog.Color := FUIMainColor;
- if ColorDialog.Execute then
- begin
- ChangeUIColor(ColorDialog.Color);
- FUIMainColor := ColorDialog.Color;
- if RealICQClient.Logined and RealICQClient.Connected then
- SaveStyleConfigs;
- SaveDefaultConfigs;
- end;
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.miMoveGroupClick(Sender: TObject);
- var
- GroupName, TargetGroupName: string;
- MenuItem: TMenuItem;
- GroupIndex, itemIndex: Integer;
- TreeView: TRealICQContacterTreeView;
- Friend: TRealICQEmployee;
- GroupMembers, TargetGroupMembers: TStringList;
- RealICQUser: TRealICQUser;
- OldScrollBarTop: Integer;
- begin
- MenuItem := Sender as TMenuItem;
- if MenuItem <> nil then
- TargetGroupName := MenuItem.Caption
- else
- TargetGroupName := LVFriends;
- ItemIndex := FContacterTreeViews.IndexOf(LVFriends);
- TreeView := FContacterTreeViews.Objects[ItemIndex] as TRealICQContacterTreeView;
- Friend := TreeView.GetSelectedEmployee;
- if Friend = nil then
- Exit;
- GroupName := Friend.BranchID;
- OldScrollBarTop := TreeView.ScrollBarTop;
- SetFlashCaptionOnOnlineValue(False);
- LockWindowUpdate(GetDesktopWindow);
- try
- if FGroups.IndexOf(GroupName) >= 0 then
- begin
- GroupIndex := FGroups.IndexOf(GroupName);
- GroupMembers := FGroups.Objects[GroupIndex] as TStringList;
- GroupMembers.Delete(GroupMembers.IndexOf(Friend.LoginName));
- end;
- RealICQUser := Friend.Data;
- TreeView.EmployeeItems.Delete(TreeView.EmployeeItems.IndexOf(Friend.LoginName));
- //在树节点之间移动（）
- Friend := TRealICQEmployee.Create(RealICQUser.LoginName);
- Friend.BranchID := TargetGroupName;
- TreeView.AddEmployee(Friend);
- //UpdateFriendNode(Friend, RealICQUser, True);
- TUsersService.GetUsersService.UpdateTreeNode(TreeView, Friend, RealICQUser);
- if FGroups.IndexOf(TargetGroupName) >= 0 then
- begin
- GroupIndex := FGroups.IndexOf(TargetGroupName);
- TargetGroupMembers := FGroups.Objects[GroupIndex] as TStringList;
- TargetGroupMembers.Add(Friend.LoginName);
- end;
- finally
- TreeView.ScrollBarTop := OldScrollBarTop;
- LockWindowUpdate(0);
- SetFlashCaptionOnOnlineValue(FFlashCaptionOnOnline);
- SaveGroupConfigs;
- end;
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.NodeDoubleClick(Employee: TRealICQEmployee);
- var
- SMSForm: TSMSForm;
- begin
- if (pgcMainWorkArea.ActivePage = tsAddrBook) then
- begin
- SMSForm := OpenSMSForm('', True);
- SMSForm.edMobiles.Text := Employee.Mobile;
- Exit;
- end;
- if Employee.Data <> nil then
- begin
- if AnsiSameText(Employee.LoginName, RealICQClient.Me.LoginName) then
- begin
- MessageBox(Handle, '对不起，不可以和自己对话！', '提示', MB_ICONINFORMATION);
- Exit;
- end;
- {if GetActiveTabSheetName=MoreUser then
- begin
- RealICQClient.GetUserInformation(Employee.LoginName,True);
- end; }
- OpenTalkingForm(Employee.LoginName);
- end;
- end;
- //小图标单击事件处理
- //------------------------------------------------------------------------------
- procedure TMainForm.NodeIconButtonClick(Sender: TObject; Employee: TRealICQEmployee; IconButtonType: TRealICQContacterTreeNodeIconButtonType);
- var
- RealICQUser: TRealICQUser;
- begin
- if IconButtonType = itHeadImage then
- begin
- HideUserCardForm;
- end;
- if IconButtonType = itSNS then
- begin
- RealICQUser := Employee.Data;
- RealICQUser.ClickedSNSIcon;
- try
- RealICQClientUserInformationReady(RealICQClient, RealICQUser);
- //UpdateEmployeeNode(Employee, RealICQUser, True);
-
//TUsersService.GetUsersService.UpdateTreeNode(Employee, RealICQUser, True);
-
finally
- ShellExecute(handle, 'open', PChar(GetDefaultBrowser), PChar(Format(RealICQClient.WebAppBaseURL + SNSHomePage, [StrToBase64(RealICQClient.LoginName), StrToBase64(MD5En(RealICQClient.Password)), StrToBase64(RealICQUser.LoginName)])), '', SW_SHOWDEFAULT);
- end;
- end;
- end;
- //小图标双击事件处理
- //------------------------------------------------------------------------------
- procedure TMainForm.NodeIconButtonDblClick(Sender: TObject; Employee: TRealICQEmployee; IconButtonType: TRealICQContacterTreeNodeIconButtonType);
- var
- TalkingForm: TTalkingForm;
- iWaitTimes: Integer;
- RealICQUser: TRealICQUser;
- SMSForm: TSMSForm;
- begin
- HideUserCardForm;
- if (pgcMainWorkArea.ActivePage = tsAddrBook) then
- begin
- SMSForm := OpenSMSForm('', True);
- SMSForm.edMobiles.Text := Employee.Mobile;
- Exit;
- end;
- if IconButtonType = itCamera then
- begin
- if AnsiSameText(Employee.LoginName, RealICQClient.Me.LoginName) then
- begin
- MessageBox(Handle, '对不起，不可以和自己对话！', '提示', MB_ICONINFORMATION);
- Exit;
- end;
- TalkingForm := GetTalkingForm(Employee.LoginName);
- if TalkingForm = nil then
- begin
- TalkingForm := OpenTalkingForm(Employee.LoginName, True);
- end;
- iWaitTimes := 0;
- while not TalkingForm.CanWriteMessage do
- begin
- Application.ProcessMessages;
- Inc(iWaitTimes);
- if iWaitTimes > 1000 then
- break;
- Sleep(10);
- end;
- TalkingForm.actVideo.Execute;
- end;
- if IconButtonType = itHeadImage then
- begin
- if pgcMainWorkArea.ActivePage = tsAddrBook then
- Exit;
- if AnsiSameText(Employee.LoginName, RealICQClient.Me.LoginName) then
- begin
- MessageBox(Handle, '对不起，不可以和自己对话！', '提示', MB_ICONINFORMATION);
- Exit;
- end;
- //Employee.UserType
- OpenTalkingForm(Employee.LoginName, True);
- //Employee.UserType
- end;
- if IconButtonType = itSMS then
- begin
- OpenSMSForm(Employee.LoginName, True);
- end;
- if IconButtonType = itEmail then
- begin
- ShellExecute(Handle, 'open', PChar('"mailto:' + Employee.Email +'"'), nil, nil, SW_SHOWNORMAL);
- //AddWebBrowserToPageControl(Format('http://mail.lishui.gov.cn/web_email/module.phtml?module=mcomposef&to=%s', [RealICQUser.Email]), 999);
- //AddWebBrowserToPageControl(Format('http://www.lxtalk.com/rd/', [RealICQUser.Email]), 999);
-
end;
- if IconButtonType = itAddFriend then
- begin
- //MessageBox(Handle, '添加好友', '提示', MB_ICONINFORMATION);
- if AnsiSameText(MainForm.RealICQClient.LoginName, Employee.LoginName) then
- begin
- MessageBox(Handle, '不能添加自己为好友', '提示', MB_ICONINFORMATION);
- Exit;
- end;
- ShowAddFriendWindow(Self, Employee.LoginName, Employee.DisplayName);
- end;
- if IconButtonType = itTel then
- begin
- MessageBox(Handle, '电话', '提示', MB_ICONINFORMATION);
- { if not FPCAMessage.GetPCALoginStatus then Exit;
- if (Employee.Mobile<>'') and (Employee.Tel<>'') then
- begin
- MenuItem:=ppSelCallTel.Items[0];
- MenuItem.Hint:=Employee.Mobile+char(10)+Employee.DisplayName;
- MenuItem:=ppSelCallTel.Items[1];
- MenuItem.Hint:=Employee.Tel+char(10)+Employee.DisplayName;
- ppSelCallTel.Popup(Mouse.CursorPos.X,Mouse.CursorPos.Y - 50);
- Exit;
- end;
- if Employee.Mobile<>'' then CallNumber:=Employee.Mobile;
- if Employee.Tel<>'' then CallNumber:=Employee.Tel;
- FPCAMessage.SendCallTelOutPCAMessage(CallNumber,Employee.DisplayName);
- }
-
end;
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.miGoSpaceClick(Sender: TObject);
- var
- LoginName: string;
- RealICQUser: TRealICQUser;
- begin
- LoginName := GetSelectedLoginName;
- if LoginName <> '' then
- begin
- RealICQUser := TUsersService.GetUsersService.GetOrRequestUser(LoginName);
- RealICQUser.ClickedSNSIcon;
- try
- RealICQClientUserInformationReady(RealICQClient, RealICQUser);
- finally
- ShellExecute(handle, 'open', PChar(GetDefaultBrowser), PChar(Format(RealICQClient.WebAppBaseURL + SNSHomePage, [StrToBase64(RealICQClient.LoginName), StrToBase64(MD5En(RealICQClient.Password)), StrToBase64(RealICQUser.LoginName)])), '', SW_SHOWDEFAULT);
- end;
- end;
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.NodeOnline(Employee: TRealICQEmployee);
- var
- ARealICQUser: TRealICQUser;
- begin
- //MessageBox(Handle, '4', '4', MB_OK);
-
if RealICQClient.Me = nil then
- Exit;
- if (DontShowHintOnBusy = True) and (RealICQClient.Me.LoginState = stBusy) and AnsiSameText(RealICQClient.Me.LeaveMessage, '忙碌') then
- Exit;
- //MessageBox(Handle, '5', '5', MB_OK);
-
if Employee.Data <> nil then
- begin
- ARealICQUser := TRealICQUser(Employee.Data);
- if ARealICQUser = RealICQClient.Me then
- Exit;
- if PlaySoundOnOnline then
- PlayEventSound(OnlineEventSound);
- if ShowHintOnOnline then
- ShowOnOffAlertForm(ARealICQUser);
- end;
- //MessageBox(Handle, '6', '6', MB_OK);
-
end;
- //------------------------------------------------------------------------------
- procedure TMainForm.NodeOffline(Employee: TRealICQEmployee);
- var
- ARealICQUser: TRealICQUser;
- begin
- if RealICQClient.Me = nil then
- Exit;
- if (DontShowHintOnBusy = True) and (RealICQClient.Me.LoginState = stBusy) and AnsiSameText(RealICQClient.Me.LeaveMessage, '忙碌') then
- Exit;
- if Employee.Data <> nil then
- begin
- ARealICQUser := TRealICQUser(Employee.Data);
- if ARealICQUser = RealICQClient.Me then
- Exit;
- if PlaySoundOnOffline then
- PlayEventSound(OfflineEventSound);
- if ShowHintOnOffline then
- ShowOnOffAlertForm(ARealICQUser);
- end;
- end;
- procedure TMainForm.TimerForShowUserCardTimer(Sender: TObject);
- begin
- TimerForShowUserCard.Enabled := False;
- TimerForHideUserCard.Enabled := False;
- if not Assigned(UserCardForm) then
- UserCardForm := TUserCardForm.Create(Self);
- UserCardForm.TargetTop := FShowUserCardTargetTop;
- UserCardForm.LoginName := FNeedShowUserCardLoginName;
- // if not Assigned(UserCardViewForm) then
- // UserCardViewForm := TUserCardViewForm.Create(Self);
- // UserCardViewForm.TargetTop := FShowUserCardTargetTop;
- // UserCardViewForm.Update(FNeedShowUserCardLoginName);
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.TimerForHideUserCardTimer(Sender: TObject);
- var
- Rect: TRect;
- begin
- TimerForHideUserCard.Enabled := False;
- if Assigned(UserCardForm) then
- begin
- Rect.Left := UserCardForm.Left;
- Rect.Top := UserCardForm.Top;
- Rect.Right := UserCardForm.Left + UserCardForm.Width;
- Rect.Bottom := UserCardForm.Top + UserCardForm.Height;
- if PtInRect(Rect, Mouse.CursorPos) then
- begin
- UserCardForm.TimerForClose.Enabled := True;
- Exit;
- end;
- end;
- if not TimerForShowUserCard.Enabled then
- FreeAndNil(UserCardForm);
- // TimerForHideUserCard.Enabled := False;
- // if Assigned(UserCardViewForm) then
- // begin
- // Rect.Left := UserCardViewForm.Left;
- // Rect.Top := UserCardViewForm.Top;
- // Rect.Right := UserCardViewForm.Left + UserCardViewForm.Width;
- // Rect.Bottom := UserCardViewForm.Top + UserCardViewForm.Height;
- // if PtInRect(Rect, Mouse.CursorPos) then
- // begin
- // UserCardViewForm.tmrForClose.Enabled := True;
- // Exit;
- // end;
- // end;
- // if not TimerForShowUserCard.Enabled then
- // FreeAndNil(UserCardViewForm);
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.NodeOnHeadImageMouseEnter(Employee: TRealICQEmployee);
- var
- Rect: TRect;
- P: TPoint;
- begin
- Rect := Employee.Node.DisplayRect(False);
- P.X := Rect.Left;
- P.Y := Rect.Top;
- P := Employee.Node.TreeView.ClientToScreen(P);
- if UserCardForm <> nil then
- begin
- FNeedShowUserCardLoginName := Employee.LoginName;
- FShowUserCardTargetTop := P.Y;
- TimerForShowUserCardTimer(nil);
- end
- else
- begin
- ShowUserCardForm(Employee.LoginName, P.Y);
- end;
- end;
- procedure TMainForm.NodeOnHeadImageMouseLeave(Employee: TRealICQEmployee);
- begin
- HideUserCardForm;
- end;
- procedure TMainForm.ItemOnHeadImageEnter(Item: TRealICQContacterListItem);
- var
- Rect: TRect;
- P: TPoint;
- begin
- Rect := Item.ListView.ListBox.ItemRect(Item.ItemIndex);
- P.X := Rect.Left;
- P.Y := Rect.Top;
- P := Item.ListView.ListBox.ClientToScreen(P);
- if UserCardForm <> nil then
- begin
- FNeedShowUserCardLoginName := Item.LoginName;
- FShowUserCardTargetTop := P.Y;
- TimerForShowUserCardTimer(nil);
- end
- else
- begin
- ShowUserCardForm(Item.LoginName, P.Y);
- end;
- end;
- procedure TMainForm.ItemOnHeadImageLeave(Item: TRealICQContacterListItem);
- begin
- HideUserCardForm;
- end;
- procedure TMainForm.imgHeadImageBorderMouseEnter(Sender: TObject);
- var
- P: TPoint;
- begin
- P.X := 0;
- P.Y := 0;
- P := imgHeadImageBorder.ClientToScreen(P);
- if UserCardForm <> nil then
- begin
- FNeedShowUserCardLoginName := RealICQClient.LoginName;
- FShowUserCardTargetTop := P.Y;
- TimerForShowUserCardTimer(nil);
- end
- else
- begin
- ShowUserCardForm(RealICQClient.LoginName, P.Y);
- end;
- end;
- procedure TMainForm.imgHeadImageBorderMouseLeave(Sender: TObject);
- begin
- HideUserCardForm;
- end;
- procedure TMainForm.ShowUserCardForm(ALoginName: string; ATargetTop: Integer);
- begin
- FNeedShowUserCardLoginName := ALoginName;
- FShowUserCardTargetTop := ATargetTop;
- TimerForShowUserCard.Enabled := False;
- TimerForShowUserCard.Enabled := True;
- TimerForHideUserCard.Enabled := False;
- end;
- procedure TMainForm.HideUserCardForm;
- begin
- if TimerForHideUserCard <> nil then
- begin
- TimerForHideUserCard.Enabled := False;
- TimerForHideUserCard.Enabled := True;
- TimerForShowUserCard.Enabled := False;
- end;
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.NodeOnMouseEnter(Employee: TRealICQEmployee);
- begin
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.NodeOnMouseLeave(Employee: TRealICQEmployee);
- begin
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.ItemOnMouseEnter(Item: TRealICQContacterListItem);
- begin
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.ItemOnMouseLeave(Item: TRealICQContacterListItem);
- begin
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.ItemIconButtonClick(Sender: TObject; Item: TRealICQContacterListItem; IconButtonType: TRealICQContacterListItemIconButtonType);
- begin
- if IconButtonType = ltHeadImage then
- begin
- if UserCardForm = nil then
- UserCardForm := TUserCardForm.Create(Self);
- if UserCardForm.Width - 10 >= Left then
- UserCardForm.Left := Left + pnlWorkArea.Width + 20
- else
- UserCardForm.Left := Left - UserCardForm.Width + 10;
- UserCardForm.Top := Mouse.CursorPos.Y - 50;
- UserCardForm.LoginName := Item.LoginName;
- Application.ProcessMessages;
- UserCardForm.Show;
- end;
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.ItemIconButtonDblClick(Sender: TObject; Item: TRealICQContacterListItem; IconButtonType: TRealICQContacterListItemIconButtonType);
- var
- TalkingForm: TTalkingForm;
- iWaitTimes: Integer;
- RealICQUser: TRealICQUser;
- // CallNumber:String;
- // MenuItem:TMenuItem;
- begin
- if FSearchListViewInVisible then //设置查找输入框为初始状态
- begin
- edFilterKeyword.Text := '查找联系人...';
- edFilterKeyword.Font.Color := clGray;
- end;
- if pnlSearchMoreUser.Visible then
- begin
- edtSearchMoreUser.Text := '查找联系人...';
- edtSearchMoreUser.Font.Color := clGray;
- end;
- if IconButtonType = ltCamera then
- begin
- TalkingForm := GetTalkingForm(Item.LoginName);
- if TalkingForm = nil then
- begin
- TalkingForm := OpenTalkingForm(Item.LoginName, True);
- end;
- iWaitTimes := 0;
- while not TalkingForm.CanWriteMessage do
- begin
- Application.ProcessMessages;
- Inc(iWaitTimes);
- if iWaitTimes > 1000 then
- break;
- Sleep(10);
- end;
- TalkingForm.actVideo.Execute;
- end;
- if IconButtonType = ltHeadImage then
- begin
- if AnsiSameText(Item.LoginName, RealICQClient.Me.LoginName) then
- begin
- MessageBox(Handle, '对不起，不可以和自己对话！', '提示', MB_ICONINFORMATION);
- Exit;
- end;
- OpenTalkingForm(Item.LoginName, True);
- end;
- if IconButtonType = ltSMS then
- begin
- OpenSMSForm(Item.LoginName, True);
- end;
- if IconButtonType = ltEmail then
- begin
- RealICQUser := TUsersService.GetUsersService.GetOrRequestUser(Item.LoginName);
- if RealICQUser <> nil then
- //AddWebBrowserToPageControl(Format('http://mail.lishui.gov.cn/web_email/module.phtml?module=mcomposef&to=%s', [RealICQUser.Email]), 999);
-
end;
- if IconButtonType = ltAddFriend then
- begin
- if AnsiSameText(MainForm.RealICQClient.LoginName, Item.LoginName) then
- begin
- MessageBox(Handle, '不能添加自己为好友', '提示', MB_ICONINFORMATION);
- Exit;
- end;
- ShowAddFriendWindow(Self, Item.LoginName, Item.DisplayName);
- end;
- if IconButtonType = ltTel then
- begin
- { if not FPCAMessage.GetPCALoginStatus then Exit;
- if (Item.Mobile<>'') and (Item.Tel<>'') then
- begin
- MenuItem:=ppSelCallTel.Items[0];
- MenuItem.Hint:=Item.Mobile+char(10)+Item.DisplayName;
- MenuItem:=ppSelCallTel.Items[1];
- MenuItem.Hint:=Item.Tel+char(10)+Item.DisplayName;
- ppSelCallTel.Popup(Mouse.CursorPos.X,Mouse.CursorPos.Y - 50);
- Exit;
- end;
- if Item.Mobile<>'' then CallNumber:=Item.Mobile;
- if Item.Tel<>'' then CallNumber:=Item.Tel;
- FPCAMessage.SendCallTelOutPCAMessage(CallNumber,Item.DisplayName);
- }
- end;
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.ItemDoubleClick(Item: TRealICQContacterListItem);
- var
- ATeam: TRealICQTeam;
- Branch: TRealICQBranch;
- begin
- if FSearchListViewInVisible then //设置查找输入框为初始状态
- begin
- edFilterKeyword.Text := '查找联系人...';
- edFilterKeyword.Font.Color := clGray;
- end;
- if IsChild(Handle, Item.ListView.Handle) then
- begin
- if GetActiveTabSheetName = LVTeams then
- begin
- ATeam := TRealICQTeam(Item.Data);
- OpenTeamTalkingForm(ATeam.TeamID);
- Exit;
- end;
- end;
- if (Item.StateIndex = 0) and (Item.Data <> nil) then //双击的是部门
-
begin
- Branch := Item.Data;
- Branch.Node.Selected := True;
- end
- else if (Item.Data <> nil) then
- begin
- if AnsiSameText(Item.LoginName, RealICQClient.Me.LoginName) then
- begin
- MessageBox(Handle, '对不起，不可以和自己对话！', '提示', MB_ICONINFORMATION);
- Exit;
- end;
- OpenTalkingForm(Item.LoginName);
- end;
- if pnlSearchMoreUser.Visible then
- begin
- edtSearchMoreUser.Text := '查找联系人...';
- end;
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.ItemOnline(Item: TRealICQContacterListItem);
- var
- iIndex: Integer;
- ARealICQUser: TRealICQUser;
- begin
- //MessageBox(Handle, '1', '1', MB_OK);
- if RealICQClient.Me = nil then
- Exit;
- if (DontShowHintOnBusy = True) and (RealICQClient.Me.LoginState = stBusy) and AnsiSameText(RealICQClient.Me.LeaveMessage, '忙碌') then
- Exit;
- iIndex := FContacterListViews.IndexOfObject(Item.ListView);
- if FContacterListViews[iIndex] = LVLatests then
- exit;
- //MessageBox(Handle, '2', '2', MB_OK);
- if Item.Data <> nil then
- begin
- ARealICQUser := TRealICQUser(Item.Data);
- if (TFriendsService.GetService.IsFriend(ARealICQUser.LoginName)) and (TWorkmatesService.GetService.IsWorkmate(ARealICQUser.LoginName)) then
- begin
- if PlaySoundOnOnline then
- PlayEventSound(OnlineEventSound);
- if ShowHintOnOnline then
- ShowOnOffAlertForm(ARealICQUser);
- end;
- end;
- //MessageBox(Handle, '3', '3', MB_OK);
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.ItemOffline(Item: TRealICQContacterListItem);
- var
- iIndex: Integer;
- ARealICQUser: TRealICQUser;
- begin
- if RealICQClient.Me = nil then
- Exit;
- if (DontShowHintOnBusy = True) and (RealICQClient.Me.LoginState = stBusy) and AnsiSameText(RealICQClient.Me.LeaveMessage, '忙碌') then
- Exit;
- iIndex := FContacterListViews.IndexOfObject(Item.ListView);
- if FContacterListViews[iIndex] = LVLatests then
- exit;
- if Item.Data <> nil then
- begin
- ARealICQUser := TRealICQUser(Item.Data);
- if (TFriendsService.GetService.IsFriend(ARealICQUser.LoginName)) and (TWorkmatesService.GetService.IsWorkmate(ARealICQUser.LoginName)) then
- begin
- if PlaySoundOnOffline then
- PlayEventSound(OfflineEventSound);
- if ShowHintOnOffline then
- ShowOnOffAlertForm(ARealICQUser);
- end;
- end;
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.lblLogsClick(Sender: TObject);
- var
- ANoticesRecord: TSystemNotices;
- begin
- ANoticesRecord := FSystemNotices[FSystemNoticeIndex];
- ShellExecute(handle, 'open', PChar(GetDefaultBrowser), PChar(Format(RealICQClient.WebAppBaseURL + LoginURL, [StrToBase64(RealICQClient.LoginName), StrToBase64(MD5En(RealICQClient.Password)), StrToBase64(ReadMessageURL + ANoticesRecord.URL)])), '', SW_SHOWDEFAULT);
- end;
- procedure TMainForm.lblLogsMouseEnter(Sender: TObject);
- begin
- lblLogs.Font.Style := [fsUnderline];
- TimerForShowSystemNotices.Enabled := False;
- end;
- procedure TMainForm.lblLogsMouseLeave(Sender: TObject);
- begin
- lblLogs.Font.Style := [];
- TimerForShowSystemNotices.Enabled := FSystemNotices.Count > 0;
- end;
- procedure TMainForm.lblReConnectClick(Sender: TObject);
- begin
- RealICQClient.ReConnectAndLogin;
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.lblRegisterMouseEnter(Sender: TObject);
- begin
- (Sender as TLabel).Font.Style := [fsUnderline];
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.lblRegisterMouseLeave(Sender: TObject);
- begin
- (Sender as TLabel).Font.Style := [];
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.ChangeUIColor(AColor: TColor);
- var
- iLoop: Integer;
- IUIColor: IRealICQUIColor;
- begin
- inherited ChangeUIColor(AColor);
- //spb360SD.ChangeUIColor(AColor);
- //spb360Safe.ChangeUIColor(AColor);
- spbNetworkBackup.ChangeUIColor(AColor);
- spbRefreshBranchUsers.ChangeUIColor(AColor);
- btShowMiniPage.ChangeUIColor(AColor);
- spbDisplayName.ChangeUIColor(AColor);
- spbWatchword.ChangeUIColor(AColor);
- shpWatchwordBorder.Pen.Color := ConvertColorToColor(shpWatchwordBorder.Pen.Color, AColor);
- spbSelUIColor.ChangeUIColor(AColor);
- spbHistroyMessage.ChangeUIColor(AColor);
- spbAddFriend.ChangeUIColor(AColor);
- spblock.ChangeUIColor(AColor);
- btMainMenu.ChangeUIColor(AColor);
- //btOA.ChangeUIColor(AColor);
- //btSwap.ChangeUIColor(AColor);
- spbShowNotReadMessage.ChangeUIColor(AColor);
- spbWinMeet.ChangeUIColor(AColor);
- spbAddFriend.Font.Color := ConvertColorToColor(spbAddFriend.Font.Color, AColor);
- spbHistroyMessage.Font.Color := ConvertColorToColor(spbHistroyMessage.Font.Color, AColor);
- spblock.Font.Color := ConvertColorToColor(spblock.Font.Color, AColor);
- ConvertBitmapToColor(MyContacters.Picture.Bitmap, AColor);
- ConvertBitmapToColor(SysMsg.Picture.Bitmap, AColor);
- ConvertBitmapToColor(MyFriend.Picture.Bitmap, AColor);
- ConvertBitmapToColor(MyTeam.Picture.Bitmap, AColor);
- ConvertBitmapToColor(Latests.Picture.Bitmap, AColor);
- ConvertBitmapToColor(MyContactersIcon.Picture.Bitmap, AColor);
- ConvertBitmapToColor(SysMsgIcon.Picture.Bitmap, AColor);
- ConvertBitmapToColor(MyFriendIcon.Picture.Bitmap, AColor);
- ConvertBitmapToColor(MyTeamIcon.Picture.Bitmap, AColor);
- ConvertBitmapToColor(LatestsIcon.Picture.Bitmap, AColor);
- ConvertBitmapToColor(RealICQHoverImage1.Picture.Bitmap, AColor);
- {通讯录}
- ConvertBitmapToColor(imgAddrBookToolbarBack.Picture.Bitmap, AColor);
- imgAddrBookToolbarBack.Invalidate;
- spbAddGroupUser.ChangeUIColor(AColor);
- spbAddGroup.ChangeUIColor(AColor);
- spbImportGroupUser.ChangeUIColor(AColor);
- {通讯录}
- ShpHint.Pen.Color := ConvertColorToColor(ShpHint.Pen.Color, AColor);
- btPrevLog.ChangeUIColor(AColor);
- btNextLog.ChangeUIColor(AColor);
- ConvertBitmapToColor(ImageForCustomerTop.Picture.Bitmap, AColor);
- ImageForCustomerTop.Invalidate;
- btCustomerLogin.ChangeUIColor(AColor);
- btCustomerLogout.ChangeUIColor(AColor);
- btCustomerDisplayName.ChangeUIColor(AColor);
- ShpLeft.Pen.Color := ConvertColorToColor(ShpLeft.Pen.Color, AColor);
- ShpBottom.Pen.Color := ConvertColorToColor(ShpBottom.Pen.Color, AColor);
- ShpRight.Pen.Color := ConvertColorToColor(ShpRight.Pen.Color, AColor);
- ShpSearchLeft.Pen.Color := ConvertColorToColor(ShpSearchLeft.Pen.Color, AColor);
- ShpSearchBottom.Pen.Color := ConvertColorToColor(ShpSearchBottom.Pen.Color, AColor);
- ShpSearchRight.Pen.Color := ConvertColorToColor(ShpSearchRight.Pen.Color, AColor);
- spbEmail.ChangeUIColor(AColor);
- sbpSMS.ChangeUIColor(AColor);
- spbPersonManage.ChangeUIColor(AColor);
- spbTelMeeting.ChangeUIColor(AColor);
- pnlToolBar.Color := FormColor;
- PnlTop.Color := FormColor;
- pnlWorkArea.Color := FormColor;
- pnlLogout.Color := FormColor;
- pgcMainWorkArea.BackColor := FormColor;
- pnlLocked.Color := FormColor;
- btn_lock_DisplayName.ChangeUIColor(AColor);
- btn_unlock.ChangeUIColor(AColor);
- ConvertBitmapToColor(img_lockback_top.Picture.Bitmap, AColor);
- //ConvertBitmapToColor(shp_lock_client.Picture.Bitmap, AColor);
- //txt_locked.color:= FormColor;
- pnlClient.Color := FormColor;
- pnlNDToolBar.Color := FormColor;
- pnlNDStateBar.Color := FormColor;
- pnlMiddleClient.Color := FormColor;
- pnlAddrBkStateBar.Color := FormColor;
- pnlCustomerServiceStatus.Color := FormColor;
- ConvertBitmapToColor(imgWebToolBack.Picture.Bitmap, AColor);
- imgWebToolBack.Invalidate;
- spbPrev.ChangeUIColor(AColor);
- spbNext.ChangeUIColor(AColor);
- spbStop.ChangeUIColor(AColor);
- spbRefresh.ChangeUIColor(AColor);
- spbAddToNA.ChangeUIColor(AColor);
- spbGo.ChangeUIColor(AColor);
- spbWebClose.ChangeUIColor(AColor);
- sbpNewWebTab.ChangeUIColor(AColor);
- TabSetMuiltWeb.BackgroundColor := ConvertColorToColor(TabSetMuiltWeb.BackgroundColor, AColor);
- TabSetMuiltWeb.SelectedColor := ConvertColorToColor(TabSetMuiltWeb.SelectedColor, AColor);
- shpWebStatus.Pen.Color := ConvertColorToColor(shpWebStatus.Pen.Color, AColor);
- shpWebLeftBorder.Pen.Color := ConvertColorToColor(shpWebLeftBorder.Pen.Color, AColor);
- ConvertBitmapToColor(imgNDToolbarBack.Picture.Bitmap, AColor);
- imgNDToolbarBack.Invalidate;
- ConvertBitmapToColor(imgLogoutBKTop.Picture.Bitmap, AColor);
- imgLogoutBKTop.Invalidate;
- ConvertBitmapToColor(imgLogoutBK.Picture.Bitmap, AColor);
- imgLogoutBK.Invalidate;
- spLoginNameBorder.Pen.Color := ConvertColorToColor(spLoginNameBorder.Pen.Color, AColor);
- spbChangeLoginName.ChangeUIColor(AColor);
- spPasswordBorder.Pen.Color := ConvertColorToColor(spPasswordBorder.Pen.Color, AColor);
- pnlSelectServer.Color := FormColor;
- spServerListBorder.Pen.Color := ConvertColorToColor(spServerListBorder.Pen.Color, AColor);
- spbSelectServer.ChangeUIColor(AColor);
- shpSearchMoreUser.Pen.Color := ConvertColorToColor(shpSearchMoreUser.Pen.Color, AColor);
- spbCancelFilter.ChangeUIColor(AColor);
- shpFilterBorder.Pen.Color := ConvertColorToColor(shpFilterBorder.Pen.Color, AColor);
- spbLoginState.ChangeUIColor(AColor);
- spbSavePassword.ChangeUIColor(AColor);
- spbAutoLogin.ChangeUIColor(AColor);
- btLogin.ChangeUIColor(AColor);
- spbNDMoveUp.ChangeUIColor(AColor);
- spbNDNewDir.ChangeUIColor(AColor);
- spbNDDelete.ChangeUIColor(AColor);
- shpNDDirBorder.Pen.Color := ConvertColorToColor(shpNDDirBorder.Pen.Color, AColor);
- spbNDUpload.ChangeUIColor(AColor);
- spbNDDownload.ChangeUIColor(AColor);
- spbNDConnect.ChangeUIColor(AColor);
- spbNDDisconnect.ChangeUIColor(AColor);
- spbNDRefresh.ChangeUIColor(AColor);
- spbNDCancelAll.ChangeUIColor(AColor);
- TabSetNDMissions.SelectedColor := clWhite;
- TabSetNDMissions.BackgroundColor := clWhite;
- pnlNDMissions.Color := clWhite;
- ConvertBitmapToColor(imgHeadImageBorder.Picture.Bitmap, AColor);
- imgHeadImageBorder.Invalidate;
- ConvertBitmapToColor(imgBottomMenu.Picture.Bitmap, AColor);
- imgBottomMenu.Invalidate;
- ConvertBitmapToColor(imgTitleBackMiddle.Picture.Bitmap, AColor);
- imgTitleBackMiddle.Invalidate;
- IUIColor := pgcMainWorkArea;
- IUIColor.ChangeUIColor(AColor);
- for iLoop := 0 to FContacterListViews.Count - 1 do
- begin
- IUIColor := FContacterListViews.Objects[iLoop] as TRealICQContacterListView;
- IUIColor.ChangeUIColor(AColor);
- end;
- for iLoop := 0 to FContacterTreeViews.Count - 1 do
- begin
- IUIColor := FContacterTreeViews.Objects[iLoop] as TRealICQContacterTreeView;
- IUIColor.ChangeUIColor(AColor);
- end;
- for iLoop := 0 to FContacterTreeViews.Count - 1 do
- begin
- IUIColor := FContacterTreeViews.Objects[iLoop] as TRealICQContacterTreeView;
- IUIColor.ChangeUIColor(AColor);
- end;
- if Assigned(FTVCustomerLatests) then
- FTVCustomerLatests.ChangeUIColor(AColor);
- // if Assigned(FLVCustomers) then FLVCustomers.ChangeUIColor(AColor);
- if Assigned(FLVSystemMessage) then
- FLVSystemMessage.ChangeUIColor(AColor);
- if Assigned(FLVTeams) then
- FLVTeams.ChangeUIColor(AColor);
- if tsNetWorkDisk.Parent <> nil then
- begin
- FLVNetWorkDisk.ChangeUIColor(AColor);
- FLVNetWorkDiskUploadingFiles.ChangeUIColor(AColor);
- FLVNetWorkDiskDownloadingFiles.ChangeUIColor(AColor);
- end;
- btLogin.ChangeUIColor(AColor);
- btLogin.Invalidate;
- spbContacterViewStyle.ChangeUIColor(AColor);
- spbCreateTeam.ChangeUIColor(AColor);
- spbFindTeam.ChangeUIColor(AColor);
- pnlTeams.Color := ConvertColorToColor(pnlTeams.Color, AColor);
- if CreateTeamForm <> nil then
- CreateTeamForm.ChangeUIColor(AColor);
- if SearchForm <> nil then
- SearchForm.ChangeUIColor(AColor);
- if SearchTeamForm <> nil then
- SearchTeamForm.ChangeUIColor(AColor);
- if SelFaceForm <> nil then
- SelFaceForm.ChangeUIColor(AColor);
- if CustomFacesManagerForm <> nil then
- CustomFacesManagerForm.ChangeUIColor(AColor);
- if NotReadMessageBoxForm <> nil then
- NotReadMessageBoxForm.ChangeUIColor(AColor);
- if VCardForm <> nil then
- VCardForm.ChangeUIColor(UIMainColor);
- ChangeAddFriendFormColor(AColor);
- ChangeAddFriendRequestFormColor(AColor);
- ChangeSeeUserInformationFormColor(AColor);
-
ChangeTalkingFormColor(AColor);
- ChangeSMSFormColor(AColor);
- ChangeTeamOptionsFormColor(AColor);
- ChangeSystemMessageFormsColor(AColor);
- TMainFormController.GetController.ChangeUIColor(AColor);
- end;
- //------------------------------------------------------------------------------
- function TMainForm.GetListViewByLoginName(ALoginName: string; AOnlyInGroups: Boolean = False): TRealICQContacterListView;
- var
- GroupName: string;
- iLoop, jLoop, iIndex, ContacterIndex: Integer;
- GroupMembers: TStringList;
- ListView: TRealICQContacterListView;
- begin
- Result := nil;
- if not AOnlyInGroups then
- begin
- if (TFriendsService.GetService.IsFriend(ALoginName)) and (TWorkmatesService.GetService.IsWorkmate(ALoginName)) then
- begin
- ContacterIndex := FContacterListViews.IndexOf(LVFriends);
- ListView := FContacterListViews.Objects[ContacterIndex] as TRealICQContacterListView;
- Result := ListView;
- end
- else if RealICQClient.Blacklists.IndexOf(ALoginName) >= 0 then
- begin
- ContacterIndex := FContacterListViews.IndexOf(LVBlacklists);
- ListView := FContacterListViews.Objects[ContacterIndex] as TRealICQContacterListView;
- if ListView.Items.IndexOf(ALoginName) = -1 then
- ListView.Items.Add(ALoginName);
- Result := ListView;
- exit;
- end
- else if RealICQClient.Strangers.IndexOf(ALoginName) >= 0 then
- begin
- ContacterIndex := FContacterListViews.IndexOf(LVStrangers);
- ListView := FContacterListViews.Objects[ContacterIndex] as TRealICQContacterListView;
- if ListView.Items.IndexOf(ALoginName) = -1 then
- ListView.Items.Add(ALoginName);
- Result := ListView;
- exit;
- end;
- end;
- if FShowGroup then
- begin
- for iLoop := 0 to FGroups.Count - 1 do
- begin
- GroupName := FGroups[iLoop];
- GroupMembers := FGroups.Objects[iLoop] as TStringList;
- for jLoop := 0 to GroupMembers.Count - 1 do
- begin
- if AnsiSameText(GroupMembers[jLoop], ALoginName) then
- begin
- iIndex := FContacterListViews.IndexOf(GroupName);
- if iIndex >= 0 then
- begin
- ListView := FContacterListViews.Objects[iIndex] as TRealICQContacterListView;
- if ListView.Items.IndexOf(ALoginName) = -1 then
- ListView.Items.Add(ALoginName);
- Result := ListView;
- end;
- exit;
- end;
- end;
- end;
- end;
- if Result <> nil then
- if Result.Items.IndexOf(ALoginName) = -1 then
- Result.Items.Add(ALoginName);
- end;
- //-------------------显示好友列表---------------
-
procedure TMainForm.ShowFriendLists;
- var
- iLoop, itemIndex: Integer;
- RealICQUser: TRealICQUser;
- RealICQFriendTreeView: TRealICQContacterTreeView;
- Friend: TRealICQEmployee;
- begin
- itemIndex := FContacterTreeViews.IndexOf(LvFriends);
- RealICQFriendTreeView := FContacterTreeViews.Objects[ItemIndex] as TRealICQContacterTreeView;
- for iLoop := FNotAddedEmployeeList.Count - 1 downto 0 do
- begin
- RealICQUser := FNotAddedEmployeeList.Objects[iLoop] as TRealICQUser;
- if AnsiSameText(RealICQUser.LoginName, RealICQClient.LoginName) then
- Continue;
- if (RealICQFriendTreeView.EmployeeItems.IndexOf(RealICQUser.LoginName)) >= 0 then
- Continue;
- Friend := TRealICQEmployee.Create(RealICQUser.LoginName);
- Friend.BranchID := LVFriends;
- RealICQFriendTreeView.AddEmployee(Friend);
- //UpdateFriendNode(Friend, RealICQUser, False);
- TUsersService.GetUsersService.UpdateTreeNode(RealICQFriendTreeView, Friend, RealICQUser);
- end;
- end;
- //------------------------------------------------------------------------------
-
procedure TMainForm.ShowGroupInterface;
- var
- GroupName, LoginName: string;
- iLoop, jLoop, itemIndex: Integer;
- RealICQUser: TRealICQUser;
- RealICQFriendTreeView: TRealICQContacterTreeView;
- Friend: TRealICQEmployee;
- FriendGroup: TRealICQBranch;
- GroupMembers: TStringList;
- begin
- ItemIndex := FContacterTreeViews.IndexOf(LVFriends);
- if ItemIndex >= 0 then
- begin
- RealICQFriendTreeView := FContacterTreeViews.Objects[ItemIndex] as TRealICQContacterTreeView;
- try
- RealICQFriendTreeView.Clear;
- FreeAndNil(RealICQFriendTreeView);
- FContacterTreeViews.Delete(ItemIndex);
- except
- end;
- end;
- ItemIndex := AddFriendTreeView(scrollBoxMyFriend, LVFriends);
- RealICQFriendTreeView := FContacterTreeViews.Objects[ItemIndex] as TRealICQContacterTreeView;
- RealICQFriendTreeView.AdjustPosition := False;
- RealICQFriendTreeView.HideSystemScrollBar;
- RealICQFriendTreeView.BeginUpdate;
- SetFlashCaptionOnOnlineValue(False);
- Screen.Cursor := crHourGlass;
- try
- //显示好友
- ShowFriendLists;
- //显示黑名单
- //ShowBlacklists;
- {$region '添加自定义分组'}
- if FShowGroup then
- begin
- for iLoop := 0 to FGroups.Count - 1 do
- begin
- GroupName := FGroups[iLoop];
- GroupMembers := FGroups.Objects[iLoop] as TStringList;
- FriendGroup := TRealICQBranch.Create(GroupName);
- FriendGroup.BranchID := GroupName;
- FriendGroup.ParentID := '';
- FriendGroup.BranchName := GroupName;
- RealICQFriendTreeView.AddBranch(FriendGroup);
- RealICQFriendTreeView.MoveBranch(GroupName, LvFriends);
- for jLoop := 0 to GroupMembers.Count - 1 do
- begin
- LoginName := GroupMembers[jLoop];
- if (not TFriendsService.GetService.IsFriend(LoginName)) and (not TWorkmatesService.GetService.IsWorkmate(LoginName)) then
- continue;
- if AnsiSameText(LoginName, RealICQClient.LoginName) then
- continue;
- RealICQUser := TUsersService.GetUsersService.GetOrRequestUser(LoginName);
- ItemIndex := RealICQFriendTreeView.EmployeeItems.IndexOf(LoginName);
- if ItemIndex >= 0 then
- RealICQFriendTreeView.EmployeeItems.Delete(ItemIndex);
- Friend := TRealICQEmployee.Create(LoginName);
- Friend.BranchID := FriendGroup.BranchName;
- RealICQFriendTreeView.AddEmployee(Friend);
- //UpdateFriendNode(Friend, RealICQUser, False);
- TUsersService.GetUsersService.UpdateTreeNode(RealICQFriendTreeView, Friend, RealICQUser);
- end;
- end;
- end;
- {$endregion}
- //展开好友列表
- ItemIndex := RealICQFriendTreeView.BranchItems.IndexOf(LvFriends);
- FriendGroup := RealICQFriendTreeView.BranchItems.Objects[itemIndex] as TRealICQBranch;
- FriendGroup.Node.Expanded := True;
- finally
- //RealICQFriendTreeView.MoveFriendGroup(LvBlackLists,LvFriends);
- PostMessage(RealICQFriendTreeView.Handle, WM_SIZE, 0, 0);
- RealICQFriendTreeView.EndUpdate;
- Screen.Cursor := crDefault;
- SetFlashCaptionOnOnlineValue(FFlashCaptionOnOnline);
- end;
- end;
- //------------------------------------------------------------------------------
- function TMainForm.AddFriendTreeView(AOwner: TWinControl; GroupName: string): Integer;
- var
- RealICQFriendTreeView: TRealICQContacterTreeView;
- Group: TRealICQBranch;
- begin
- //log(AOwner.Name,'TMainForm.AddFriendTreeView');
- RealICQFriendTreeView := TRealICQContacterTreeView.Create(AOwner);
- RealICQFriendTreeView.Parent := AOwner;
- RealICQFriendTreeView.Align := alClient;
- RealICQFriendTreeView.Caption := '';
- RealICQFriendTreeView.Color := clWhite;
- RealICQFriendTreeView.ShowHint := True;
- RealICQFriendTreeView.ParentFont := True;
- RealICQFriendTreeView.ShowLine := False;
- RealICQFriendTreeView.ShowBranchImage := False;
- RealICQFriendTreeView.MustDrawButton := True;
- RealICQFriendTreeView.ScrollTopButtonPictureNormal.LoadFromFile(ExtractFilePath(Application.ExeName) + ScrollBarTopButtonPicture);
- RealICQFriendTreeView.ScrollTopButtonPictureHover.LoadFromFile(ExtractFilePath(Application.ExeName) + ScrollBarTopButtonHoverPicture);
- RealICQFriendTreeView.ScrollTopButtonPictureDown.LoadFromFile(ExtractFilePath(Application.ExeName) + ScrollBarTopButtonDownPicture);
- RealICQFriendTreeView.ScrollBottomButtonPictureNormal.LoadFromFile(ExtractFilePath(Application.ExeName) + ScrollBarBottomButtonPicture);
- RealICQFriendTreeView.ScrollBottomButtonPictureHover.LoadFromFile(ExtractFilePath(Application.ExeName) + ScrollBarBottomButtonHoverPicture);
- RealICQFriendTreeView.ScrollBottomButtonPictureDown.LoadFromFile(ExtractFilePath(Application.ExeName) + ScrollBarBottomButtonDownPicture);
- RealICQFriendTreeView.ScrollBarButtonTopPictureNormal.LoadFromFile(ExtractFilePath(Application.ExeName) + ScrollBarTrackButtonTopPicture);
- RealICQFriendTreeView.ScrollBarButtonTopPictureHover.LoadFromFile(ExtractFilePath(Application.ExeName) + ScrollBarTrackButtonTopHoverPicture);
- RealICQFriendTreeView.ScrollBarButtonTopPictureDown.LoadFromFile(ExtractFilePath(Application.ExeName) + ScrollBarTrackButtonTopDownPicture);
- RealICQFriendTreeView.ScrollBarButtonMiddlePictureNormal.LoadFromFile(ExtractFilePath(Application.ExeName) + ScrollBarTrackButtonMiddlePicture);
- RealICQFriendTreeView.ScrollBarButtonMiddlePictureHover.LoadFromFile(ExtractFilePath(Application.ExeName) + ScrollBarTrackButtonMiddleHoverPicture);
- RealICQFriendTreeView.ScrollBarButtonMiddlePictureDown.LoadFromFile(ExtractFilePath(Application.ExeName) + ScrollBarTrackButtonMiddleDownPicture);
- RealICQFriendTreeView.ScrollBarButtonBottomPictureNormal.LoadFromFile(ExtractFilePath(Application.ExeName) + ScrollBarTrackButtonBottomPicture);
- RealICQFriendTreeView.ScrollBarButtonBottomPictureHover.LoadFromFile(ExtractFilePath(Application.ExeName) + ScrollBarTrackButtonBottomHoverPicture);
- RealICQFriendTreeView.ScrollBarButtonBottomPictureDown.LoadFromFile(ExtractFilePath(Application.ExeName) + ScrollBarTrackButtonBottomDownPicture);
- RealICQFriendTreeView.ScrollBackgroundPictureNormal.LoadFromFile(ExtractFilePath(Application.ExeName) + ScrollBackgroundPicture);
- RealICQFriendTreeView.ScrollBackgroundPictureHover.LoadFromFile(ExtractFilePath(Application.ExeName) + ScrollBackgroundPicture);
- RealICQFriendTreeView.ScrollBackgroundPictureDown.LoadFromFile(ExtractFilePath(Application.ExeName) + ScrollBackgroundPicture);
- RealICQFriendTreeView.ScrollBarButtonPicture.LoadFromFile(ExtractFilePath(Application.ExeName) + ScrollBarButtonPicture);
- RealICQFriendTreeView.SelectedItemBorderColor := FLVSelectedItemBorderColor;
- RealICQFriendTreeView.SelectedItemBorderInnerColor := FLVSelectedItemBorderInnerColor;
- RealICQFriendTreeView.SelectedItemBackColor := FLVSelectedItemBackColor;
- RealICQFriendTreeView.HeadImageBorderColor := FLVHeadImageBorderColor;
- RealICQFriendTreeView.HeadImageBackColor := FLVHeadImageBackColor;
- RealICQFriendTreeView.SelectedItemBackgroud.LoadFromFile(ExtractFilePath(Application.ExeName) + SelectedItemBackgroud);
- RealICQFriendTreeView.DefaultPicture.LoadFromFile(ExtractFilePath(Application.ExeName) + DefaultPictureSmall);
- RealICQFriendTreeView.DefaultPictureBig.LoadFromFile(ExtractFilePath(Application.ExeName) + DefaultPictureBig44);
- RealICQFriendTreeView.BranchClosedButtonPicture.LoadFromFile(ExtractFilePath(Application.ExeName) + GroupClosedButtonPicture);
- RealICQFriendTreeView.BranchOpenedButtonPicture.LoadFromFile(ExtractFilePath(Application.ExeName) + GroupOpenedButtonPicture);
- RealICQFriendTreeView.LeavePicture.LoadFromFile(ExtractFilePath(Application.ExeName) + 'Images\State\small\away.ico');
- RealICQFriendTreeView.BusyPicture.LoadFromFile(ExtractFilePath(Application.ExeName) + 'Images\State\small\busy.ico');
- RealICQFriendTreeView.MutePicture.LoadFromFile(ExtractFilePath(Application.ExeName) + 'Images\State\small\mute.ico');
- RealICQFriendTreeView.LeavePictureBig.LoadFromFile(ExtractFilePath(Application.ExeName) + 'Images\State\Big\away.ico');
- RealICQFriendTreeView.BusyPictureBig.LoadFromFile(ExtractFilePath(Application.ExeName) + 'Images\State\Big\busy.ico');
- RealICQFriendTreeView.MutePictureBig.LoadFromFile(ExtractFilePath(Application.ExeName) + 'Images\State\Big\mute.ico');
- RealICQFriendTreeView.CameraIcon.LoadFromFile(ExtractFilePath(Application.ExeName) + CameraIcon);
- RealICQFriendTreeView.TelephoneIcon.LoadFromFile(ExtractFilePath(Application.ExeName) + TelephoneIcon);
- RealICQFriendTreeView.MobilePhoneIcon.LoadFromFile(ExtractFilePath(Application.ExeName) + MobilePhoneIcon);
- RealICQFriendTreeView.EmailIcon.LoadFromFile(ExtractFilePath(Application.ExeName) + EmailIcon);
- RealICQFriendTreeView.SMSIcon.LoadFromFile(ExtractFilePath(Application.ExeName) + SMSIcon);
- RealICQFriendTreeView.ShowCameraButton := True;
- RealICQFriendTreeView.ShowMobileButton := False;
- RealICQFriendTreeView.ShowTelButton := True;
- RealICQFriendTreeView.ShowHeadImageButton := True;
- RealICQFriendTreeView.ShowEmailButton := True;
- RealICQFriendTreeView.ShowSMSButton := True;
- RealICQFriendTreeView.ShowAddFriendButton := False;
- RealICQFriendTreeView.Style := FLVStyle;
- RealICQFriendTreeView.CaptionStyle := FLVCaptionStyle;
- RealICQFriendTreeView.ChangeUIColor(FUIMainColor);
- RealICQFriendTreeView.PopupMenu := ppUserItemRightMenu;
- RealICQFriendTreeView.OnItemOnline := NodeOnline;
- RealICQFriendTreeView.OnItemOffline := NodeOffline;
- RealICQFriendTreeView.OnItemDoubleClick := NodeDoubleClick;
- RealICQFriendTreeView.OnItemIconButtonClick := NodeIconButtonClick;
- RealICQFriendTreeView.OnItemIconButtonDblClick := NodeIconButtonDblClick;
- RealICQFriendTreeView.OnItemMouseEnter := NodeOnMouseEnter;
- RealICQFriendTreeView.OnItemMouseLeave := NodeOnMouseLeave;
- Result := FContacterTreeViews.AddObject(GroupName, RealICQFriendTreeView);
- RealICQFriendTreeView.AdjustPosition := False;
- RealICQFriendTreeView.HideSystemScrollBar;
- RealICQFriendTreeView.BeginUpdate;
- try
- Group := TRealICQBranch.Create(LVFriends);
- Group.BranchID := LvFriends;
- Group.ParentID := '0';
- Group.BranchName := LvFriends;
- RealICQFriendTreeView.AddBranch(Group);
- finally
- RealICQFriendTreeView.EndUpdate;
- end;
- end;
- function TMainForm.AddContacterTreeView(AOwner: TWinControl; GroupName: string): Integer;
- var
- RealICQContacterTreeView: TRealICQContacterTreeView;
- begin
- //log(AOwner.Name,'TMainForm.AddContacterTreeView');
- RealICQContacterTreeView := TRealICQContacterTreeView.Create(AOwner);
- RealICQContacterTreeView.Parent := AOwner;
- RealICQContacterTreeView.Align := alClient;
- RealICQContacterTreeView.Caption := '';
- RealICQContacterTreeView.Color := clWhite;
- RealICQContacterTreeView.ShowHint := True;
- RealICQContacterTreeView.ParentFont := True;
- RealICQContacterTreeView.AutoCalculate := True;
- RealICQContacterTreeView.AutoChangeOnlineNumeric := True;
- RealICQContacterTreeView.ShowOnlineNumber := True;
- RealICQContacterTreeView.ScrollTopButtonPictureNormal.LoadFromFile(ExtractFilePath(Application.ExeName) + ScrollBarTopButtonPicture);
- RealICQContacterTreeView.ScrollTopButtonPictureHover.LoadFromFile(ExtractFilePath(Application.ExeName) + ScrollBarTopButtonHoverPicture);
- RealICQContacterTreeView.ScrollTopButtonPictureDown.LoadFromFile(ExtractFilePath(Application.ExeName) + ScrollBarTopButtonDownPicture);
- RealICQContacterTreeView.ScrollBottomButtonPictureNormal.LoadFromFile(ExtractFilePath(Application.ExeName) + ScrollBarBottomButtonPicture);
- RealICQContacterTreeView.ScrollBottomButtonPictureHover.LoadFromFile(ExtractFilePath(Application.ExeName) + ScrollBarBottomButtonHoverPicture);
- RealICQContacterTreeView.ScrollBottomButtonPictureDown.LoadFromFile(ExtractFilePath(Application.ExeName) + ScrollBarBottomButtonDownPicture);
- RealICQContacterTreeView.ScrollBarButtonTopPictureNormal.LoadFromFile(ExtractFilePath(Application.ExeName) + ScrollBarTrackButtonTopPicture);
- RealICQContacterTreeView.ScrollBarButtonTopPictureHover.LoadFromFile(ExtractFilePath(Application.ExeName) + ScrollBarTrackButtonTopHoverPicture);
- RealICQContacterTreeView.ScrollBarButtonTopPictureDown.LoadFromFile(ExtractFilePath(Application.ExeName) + ScrollBarTrackButtonTopDownPicture);
- RealICQContacterTreeView.ScrollBarButtonMiddlePictureNormal.LoadFromFile(ExtractFilePath(Application.ExeName) + ScrollBarTrackButtonMiddlePicture);
- RealICQContacterTreeView.ScrollBarButtonMiddlePictureHover.LoadFromFile(ExtractFilePath(Application.ExeName) + ScrollBarTrackButtonMiddleHoverPicture);
- RealICQContacterTreeView.ScrollBarButtonMiddlePictureDown.LoadFromFile(ExtractFilePath(Application.ExeName) + ScrollBarTrackButtonMiddleDownPicture);
- RealICQContacterTreeView.ScrollBarButtonBottomPictureNormal.LoadFromFile(ExtractFilePath(Application.ExeName) + ScrollBarTrackButtonBottomPicture);
- RealICQContacterTreeView.ScrollBarButtonBottomPictureHover.LoadFromFile(ExtractFilePath(Application.ExeName) + ScrollBarTrackButtonBottomHoverPicture);
- RealICQContacterTreeView.ScrollBarButtonBottomPictureDown.LoadFromFile(ExtractFilePath(Application.ExeName) + ScrollBarTrackButtonBottomDownPicture);
- RealICQContacterTreeView.ScrollBackgroundPictureNormal.LoadFromFile(ExtractFilePath(Application.ExeName) + ScrollBackgroundPicture);
- RealICQContacterTreeView.ScrollBackgroundPictureHover.LoadFromFile(ExtractFilePath(Application.ExeName) + ScrollBackgroundPicture);
- RealICQContacterTreeView.ScrollBackgroundPictureDown.LoadFromFile(ExtractFilePath(Application.ExeName) + ScrollBackgroundPicture);
- RealICQContacterTreeView.ScrollBarButtonPicture.LoadFromFile(ExtractFilePath(Application.ExeName) + ScrollBarButtonPicture);
- RealICQContacterTreeView.SelectedItemBorderColor := FLVSelectedItemBorderColor;
- RealICQContacterTreeView.SelectedItemBorderInnerColor := FLVSelectedItemBorderInnerColor;
- RealICQContacterTreeView.SelectedItemBackColor := FLVSelectedItemBackColor;
- RealICQContacterTreeView.HeadImageBorderColor := FLVHeadImageBorderColor;
- RealICQContacterTreeView.HeadImageBackColor := FLVHeadImageBackColor;
- RealICQContacterTreeView.SelectedItemBackgroud.LoadFromFile(ExtractFilePath(Application.ExeName) + SelectedItemBackgroud);
- RealICQContacterTreeView.DefaultPicture.LoadFromFile(ExtractFilePath(Application.ExeName) + DefaultPictureSmall);
- RealICQContacterTreeView.DefaultPictureBig.LoadFromFile(ExtractFilePath(Application.ExeName) + DefaultPictureBig44);
- RealICQContacterTreeView.BranchExpandedPicture.LoadFromFile(ExtractFilePath(Application.ExeName) + BranchExpandedPicture);
- RealICQContacterTreeView.BranchCollapsedPicture.LoadFromFile(ExtractFilePath(Application.ExeName) + BranchCollapsedPicture);
- RealICQContacterTreeView.BranchClosedButtonPicture.LoadFromFile(ExtractFilePath(Application.ExeName) + BranchClosedButtonPicture);
- RealICQContacterTreeView.BranchOpenedButtonPicture.LoadFromFile(ExtractFilePath(Application.ExeName) + BranchOpenedButtonPicture);
- RealICQContacterTreeView.LeavePicture.LoadFromFile(ExtractFilePath(Application.ExeName) + 'Images\State\small\away.ico');
- RealICQContacterTreeView.BusyPicture.LoadFromFile(ExtractFilePath(Application.ExeName) + 'Images\State\small\busy.ico');
- RealICQContacterTreeView.MutePicture.LoadFromFile(ExtractFilePath(Application.ExeName) + 'Images\State\small\mute.ico');
- RealICQContacterTreeView.LeavePictureBig.LoadFromFile(ExtractFilePath(Application.ExeName) + 'Images\State\Big\away.ico');
- RealICQContacterTreeView.BusyPictureBig.LoadFromFile(ExtractFilePath(Application.ExeName) + 'Images\State\Big\busy.ico');
- RealICQContacterTreeView.MutePictureBig.LoadFromFile(ExtractFilePath(Application.ExeName) + 'Images\State\Big\mute.ico');
- RealICQContacterTreeView.CameraIcon.LoadFromFile(ExtractFilePath(Application.ExeName) + CameraIcon);
- RealICQContacterTreeView.TelephoneIcon.LoadFromFile(ExtractFilePath(Application.ExeName) + TelephoneIcon);
- RealICQContacterTreeView.MobilePhoneIcon.LoadFromFile(ExtractFilePath(Application.ExeName) + MobilePhoneIcon);
- RealICQContacterTreeView.EmailIcon.LoadFromFile(ExtractFilePath(Application.ExeName) + EmailIcon);
- RealICQContacterTreeView.SMSIcon.LoadFromFile(ExtractFilePath(Application.ExeName) + SMSIcon);
- RealICQContacterTreeView.AddFriendIcon.LoadFromFile(ExtractFilePath(Application.ExeName) + AddFriendIcon);
- RealICQContacterTreeView.NewSNSUpdateIcon.LoadFromFile(ExtractFilePath(Application.ExeName) + SNSIcon);
- RealICQContacterTreeView.CheckFalsePicture.LoadFromFile(ExtractFilePath(Application.ExeName) + 'Images\CheckFalse.bmp');
- RealICQContacterTreeView.CheckTruePicture.LoadFromFile(ExtractFilePath(Application.ExeName) + 'Images\CheckTrue.bmp');
- RealICQContacterTreeView.ShowMobileButton := False;
- RealICQContacterTreeView.ShowTelButton := True;
- RealICQContacterTreeView.ShowCameraButton := True;
- RealICQContacterTreeView.ShowHeadImageButton := True;
- RealICQContacterTreeView.ShowEmailButton := True;
- RealICQContacterTreeView.ShowSMSButton := True;
- RealICQContacterTreeView.ShowNewSNSButton := False;
- RealICQContacterTreeView.ShowAddFriendButton := True;
- // if RealICQClient.EnableSecretLevel AND (FProductType <> ptBGZS) AND ((FUserType = utUnknown) OR (FUserType = utCompany)) then
- // RealICQContacterTreeView.ShowAddFriendButton := True
- // else
- // RealICQContacterTreeView.ShowAddFriendButton := False;
- RealICQContacterTreeView.Style := FLVStyle;
- RealICQContacterTreeView.CaptionStyle := FLVCaptionStyle;
- RealICQContacterTreeView.ChangeUIColor(FUIMainColor);
- RealICQContacterTreeView.PopupMenu := ppUserItemRightMenu;
- if GroupName = LVMoreUsers then
- begin
- RealICQContacterTreeView.OnBranchClick := NodeBranchClick;
- end;
- if GroupName = LVAddrbook then
- begin
- RealICQContacterTreeView.OnBranchClick := NodeGroupClick;
- end;
- RealICQContacterTreeView.OnItemOnline := NodeOnline;
- RealICQContacterTreeView.OnItemOffline := NodeOffline;
- RealICQContacterTreeView.OnItemDoubleClick := NodeDoubleClick;
- RealICQContacterTreeView.OnItemIconButtonClick := NodeIconButtonClick;
- RealICQContacterTreeView.OnItemIconButtonDblClick := NodeIconButtonDblClick;
- RealICQContacterTreeView.OnItemMouseEnter := NodeOnMouseEnter;
- RealICQContacterTreeView.OnItemMouseLeave := NodeOnMouseLeave;
- Result := FContacterTreeViews.AddObject(GroupName, RealICQContacterTreeView);
- end;
- procedure TMainForm.UpdateContacterListView(RealICQContacterListView: TRealICQContacterListView);
- begin
- RealICQContacterListView.Align := alClient;
- RealICQContacterListView.Caption := '';
- RealICQContacterListView.ShowHint := True;
- RealICQContacterListView.Color := clWhite;
- RealICQContacterListView.ParentFont := True;
- RealICQContacterListView.ScrollTopButtonPictureNormal.LoadFromFile(ExtractFilePath(Application.ExeName) + ScrollBarTopButtonPicture);
- RealICQContacterListView.ScrollTopButtonPictureHover.LoadFromFile(ExtractFilePath(Application.ExeName) + ScrollBarTopButtonHoverPicture);
- RealICQContacterListView.ScrollTopButtonPictureDown.LoadFromFile(ExtractFilePath(Application.ExeName) + ScrollBarTopButtonDownPicture);
- RealICQContacterListView.ScrollBottomButtonPictureNormal.LoadFromFile(ExtractFilePath(Application.ExeName) + ScrollBarBottomButtonPicture);
- RealICQContacterListView.ScrollBottomButtonPictureHover.LoadFromFile(ExtractFilePath(Application.ExeName) + ScrollBarBottomButtonHoverPicture);
- RealICQContacterListView.ScrollBottomButtonPictureDown.LoadFromFile(ExtractFilePath(Application.ExeName) + ScrollBarBottomButtonDownPicture);
- RealICQContacterListView.ScrollBarButtonTopPictureNormal.LoadFromFile(ExtractFilePath(Application.ExeName) + ScrollBarTrackButtonTopPicture);
- RealICQContacterListView.ScrollBarButtonTopPictureHover.LoadFromFile(ExtractFilePath(Application.ExeName) + ScrollBarTrackButtonTopHoverPicture);
- RealICQContacterListView.ScrollBarButtonTopPictureDown.LoadFromFile(ExtractFilePath(Application.ExeName) + ScrollBarTrackButtonTopDownPicture);
- RealICQContacterListView.ScrollBarButtonMiddlePictureNormal.LoadFromFile(ExtractFilePath(Application.ExeName) + ScrollBarTrackButtonMiddlePicture);
- RealICQContacterListView.ScrollBarButtonMiddlePictureHover.LoadFromFile(ExtractFilePath(Application.ExeName) + ScrollBarTrackButtonMiddleHoverPicture);
- RealICQContacterListView.ScrollBarButtonMiddlePictureDown.LoadFromFile(ExtractFilePath(Application.ExeName) + ScrollBarTrackButtonMiddleDownPicture);
- RealICQContacterListView.ScrollBarButtonBottomPictureNormal.LoadFromFile(ExtractFilePath(Application.ExeName) + ScrollBarTrackButtonBottomPicture);
- RealICQContacterListView.ScrollBarButtonBottomPictureHover.LoadFromFile(ExtractFilePath(Application.ExeName) + ScrollBarTrackButtonBottomHoverPicture);
- RealICQContacterListView.ScrollBarButtonBottomPictureDown.LoadFromFile(ExtractFilePath(Application.ExeName) + ScrollBarTrackButtonBottomDownPicture);
- RealICQContacterListView.ScrollBackgroundPictureNormal.LoadFromFile(ExtractFilePath(Application.ExeName) + ScrollBackgroundPicture);
- RealICQContacterListView.ScrollBackgroundPictureHover.LoadFromFile(ExtractFilePath(Application.ExeName) + ScrollBackgroundPicture);
- RealICQContacterListView.ScrollBackgroundPictureDown.LoadFromFile(ExtractFilePath(Application.ExeName) + ScrollBackgroundPicture);
- RealICQContacterListView.SelectedItemBorderColor := FLVSelectedItemBorderColor;
- RealICQContacterListView.SelectedItemBorderInnerColor := FLVSelectedItemBorderInnerColor;
- RealICQContacterListView.SelectedItemBackColor := FLVSelectedItemBackColor;
- RealICQContacterListView.HeadImageBorderColor := FLVHeadImageBorderColor;
- RealICQContacterListView.HeadImageBackColor := FLVHeadImageBackColor;
- RealICQContacterListView.SelectedItemBackgroud.LoadFromFile(ExtractFilePath(Application.ExeName) + SelectedItemBackgroud);
- RealICQContacterListView.DefaultPictureBig.LoadFromFile(ExtractFilePath(Application.ExeName) + DefaultPictureBig);
- RealICQContacterListView.DefaultPictureMiddle.LoadFromFile(ExtractFilePath(Application.ExeName) + DefaultPictureMiddle);
- RealICQContacterListView.DefaultPictureSmall.LoadFromFile(ExtractFilePath(Application.ExeName) + DefaultPictureSmall);
- //RealICQContacterListView.DefaultPictureBigOffline.LoadFromFile(ExtractFilePath(Application.ExeName) + DefaultPictureBigOffline);
- //RealICQContacterListView.DefaultPictureMiddleOffline.LoadFromFile(ExtractFilePath(Application.ExeName) + DefaultPictureMiddleOffline);
- //RealICQContacterListView.DefaultPictureSmallOffline.LoadFromFile(ExtractFilePath(Application.ExeName) + DefaultPictureSmallOffline);
- RealICQContacterListView.LeavePicture.LoadFromFile(ExtractFilePath(Application.ExeName) + 'Images\State\small\away.ico');
- RealICQContacterListView.BusyPicture.LoadFromFile(ExtractFilePath(Application.ExeName) + 'Images\State\small\busy.ico');
- RealICQContacterListView.MutePicture.LoadFromFile(ExtractFilePath(Application.ExeName) + 'Images\State\small\mute.ico');
- RealICQContacterListView.LeavePictureBig.LoadFromFile(ExtractFilePath(Application.ExeName) + 'Images\State\Big\away.ico');
- RealICQContacterListView.BusyPictureBig.LoadFromFile(ExtractFilePath(Application.ExeName) + 'Images\State\Big\busy.ico');
- RealICQContacterListView.MutePictureBig.LoadFromFile(ExtractFilePath(Application.ExeName) + 'Images\State\Big\mute.ico');
- RealICQContacterListView.CameraIcon.LoadFromFile(ExtractFilePath(Application.ExeName) + CameraIcon);
- RealICQContacterListView.TelephoneIcon.LoadFromFile(ExtractFilePath(Application.ExeName) + TelephoneIcon);
- RealICQContacterListView.MobilePhoneIcon.LoadFromFile(ExtractFilePath(Application.ExeName) + MobilePhoneIcon);
- RealICQContacterListView.EmailIcon.LoadFromFile(ExtractFilePath(Application.ExeName) + EmailIcon);
- RealICQContacterListView.SMSIcon.LoadFromFile(ExtractFilePath(Application.ExeName) + SMSIcon);
- RealICQContacterListView.AddFriendIcon.LoadFromFile(ExtractFilePath(Application.ExeName) + AddFriendIcon);
- RealICQContacterListView.ShowHeadImageButton := False;
- RealICQContacterListView.ShowAddFriendButton := False;
- RealICQContacterListView.ShowMobileButton := True;
- RealICQContacterListView.ShowTelButton := True;
- RealICQContacterListView.ShowCameraButton := True;
- RealICQContacterListView.ShowEmailButton := True;
- RealICQContacterListView.ShowSMSButton := True;
- RealICQContacterListView.Style := FLVStyle;
- RealICQContacterListView.CaptionStyle := FLVCaptionStyle;
- RealICQContacterListView.ChangeUIColor(FUIMainColor);
- RealICQContacterListView.PopupMenu := ppUserItemRightMenu;
- RealICQContacterListView.OnItemDoubleClick := ItemDoubleClick;
- RealICQContacterListView.OnItemIconButtonClick := ItemIconButtonClick;
- RealICQContacterListView.OnItemIconButtonDblClick := ItemIconButtonDblClick;
- RealICQContacterListView.OnItemMouseEnter := nil; // ItemOnMouseEnter;
-
RealICQContacterListView.OnItemMouseLeave := nil; // ItemOnMouseLeave;
-
end;
- //------------------------------------------------------------------------------
-
function TMainForm.AddContacterListView(AOwner: TWinControl; GroupName: string): Integer;
- var
- RealICQContacterListView: TRealICQContacterListView;
- begin
- //log(AOwner.Name,'TMainForm.AddContacterListView');
- RealICQContacterListView := TRealICQContacterListView.Create(AOwner);
- RealICQContacterListView.Parent := AOwner;
- UpdateContacterListView(RealICQContacterListView);
- RealICQContacterListView.ShowMobileButton := not (GroupName = LVMoreUsers);
- RealICQContacterListView.ShowTelButton := not (GroupName = LVMoreUsers);
- RealICQContacterListView.ShowCameraButton := not (GroupName = LVMoreUsers);
- RealICQContacterListView.ShowHeadImageButton := False; //not (GroupName=LVMoreUsers);
-
RealICQContacterListView.ShowEmailButton := False; // not (GroupName=LVMoreUsers);
-
RealICQContacterListView.ShowSMSButton := not (GroupName = LVMoreUsers);
- // if RealICQClient.EnableSecretLevel AND (FProductType <> ptBGZS) AND ((FUserType = utUnknown) OR (FUserType = utCompany)) then
- // RealICQContacterListView.ShowAddFriendButton := True
- // else
- RealICQContacterListView.ShowAddFriendButton := False;
- if GroupName = LVMoreUsers then
- begin
- RealICQContacterListView.OnItemOnline := nil;
- RealICQContacterListView.OnItemOffline := nil;
- end
- else
- begin
- RealICQContacterListView.OnItemOnline := ItemOnline;
- RealICQContacterListView.OnItemOffline := ItemOffline;
- end;
- Result := FContacterListViews.AddObject(GroupName, RealICQContacterListView);
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.ApplicationEventsDeactivate(Sender: TObject);
- begin
- if edWatchword.Visible then
- edWatchwordExit(edWatchword);
- //FDblClickedTrayIcon := False;
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.ApplicationEventsException(Sender: TObject; E: Exception);
- var
- LogFile: TextFile;
- Log: string;
- begin
- Exit;
- try
- Log := DateTimeToStr(Now) + '：' + E.Message;
- AssignFile(LogFile, ExtractFilePath(Application.ExeName) + 'Logs.txt');
- try
- try
- Append(LogFile);
- except
- ReWrite(LogFile);
- end;
- Writeln(LogFile, Log);
- finally
- CloseFile(LogFile);
- end;
- except
- end;
- end;
- procedure TMainForm.ApplicationEventsMessage(var Msg: tagMSG; var Handled: Boolean);
- var
- classname: array[0..254] of char;
- begin
- if (Msg.message = WM_CLOSE) then
- begin
- getclassname(msg.hwnd, @classname, sizeof(classname)); //取类名
- if classname = 'Shell Embedding' then
- begin
- PeekMessage(Msg, Msg.Hwnd, 0, 0, PM_REMOVE);
- Handled := True; //该消息已处理，不再需要后续处理
- end;
- end;
- if (Msg.message = WM_LBUTTONDOWN) or (Msg.message = WM_NCLBUTTONDOWN) then
- begin
- if IsChild(Handle, Msg.hwnd) then
- begin
- HideUserCardForm;
- end;
- end;
- end;
- procedure TMainForm.ppAddrBookListGetControlClass(Sender: TCustomActionBar; AnItem: TActionClient; var ControlClass: TCustomActionControlClass);
- begin
- ChangePPMenuColorMap(ppAddrBookList.PopupMenu);
- end;
- procedure TMainForm.ppAddrBookListPopup(Sender: TObject);
- var
- ItemIndex: Integer;
- RealICQContacterTreeView: TRealICQContacterTreeView;
- begin
- ItemIndex := FContacterTreeViews.IndexOf(LVAddrBook);
- RealICQContacterTreeView := MainForm.ContacterTreeViews.Objects[ItemIndex] as TRealICQContacterTreeView;
- miUpdateGroup.Enabled := (RealICQContacterTreeView.GetSelectedBranch <> nil);
- miDelGroup.Enabled := (RealICQContacterTreeView.GetSelectedBranch <> nil);
- miImportGroupUser.Enabled := (RealICQContacterTreeView.GetSelectedBranch <> nil);
- miDelGroupUser.Enabled := (RealICQContacterTreeView.GetSelectedEmployee <> nil);
- miUpdateGroupUser.Enabled := (RealICQContacterTreeView.GetSelectedEmployee <> nil);
- miCut.Enabled := (RealICQContacterTreeView.GetSelectedBranch <> nil) or (RealICQContacterTreeView.GetSelectedEmployee <> nil);
- miPaste.Enabled := (FCutNode <> nil);
- miSetRemark.Enabled := (RealICQContacterTreeView.GetSelectedEmployee <> nil);
- end;
- procedure TMainForm.ppChangeCustomerStateGetControlClass(Sender: TCustomActionBar; AnItem: TActionClient; var ControlClass: TCustomActionControlClass);
- begin
- ChangePPMenuColorMap(ppChangeCustomerState.PopupMenu);
- end;
- procedure TMainForm.ppChangeStatesGetControlClass(Sender: TCustomActionBar; AnItem: TActionClient; var ControlClass: TCustomActionControlClass);
- begin
- ChangePPMenuColorMap(ppChangeStates.PopupMenu);
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.ppChangeStatesPopup(Sender: TObject);
- begin
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.ppColorsGetControlClass(Sender: TCustomActionBar; AnItem: TActionClient; var ControlClass: TCustomActionControlClass);
- begin
- ChangePPMenuColorMap(ppColors.PopupMenu);
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.ppColorsPopup(Sender: TObject);
- var
- iLoop: Integer;
- ColorStr: string;
- MenuItem: TMenuItem;
- Bitmap: TBitmap;
- procedure FindSkins(APath: string);
- var
- DSearchRec: TSearchRec;
- FindResult: Integer;
- begin
- FindResult := FindFirst(APath + '*.*', faDirectory, DSearchRec);
- while FindResult = 0 do
- begin
- if (DSearchRec.Name <> '.') and (DSearchRec.Name <> '..') then
- if (DSearchRec.Attr and faDirectory) = faDirectory then
- begin
- MenuItem := TMenuItem.Create(miSkins);
- MenuItem.Caption := DSearchRec.Name;
- MenuItem.OnClick := miSkinClick;
- MenuItem.Enabled := SkinName <> DSearchRec.Name;
- MenuItem.Checked := SkinName = DSearchRec.Name;
- miSkins.Insert(0, MenuItem);
- end;
- FindResult := FindNext(DSearchRec);
- end;
- end;
- begin
- ImgLstColors.Clear;
- while ppColors.Items.Count > 4 do
- ppColors.Items.Delete(0);
- Bitmap := TBitmap.Create;
- Bitmap.SetSize(16, 16);
- try
- for iLoop := ColorDialog.CustomColors.Count - 1 downto 0 do
- begin
- ColorStr := Copy(ColorDialog.CustomColors[iLoop], 8, 6);
- if ColorStr = 'FFFFFF' then
- continue;
- ColorStr := '$00' + ColorStr;
- Bitmap.Canvas.Pen.Color := clGray;
- Bitmap.Canvas.Pen.Style := psSolid;
- Bitmap.Canvas.Brush.Color := StrToInt(ColorStr);
- Bitmap.Canvas.Brush.Style := bsSolid;
- Bitmap.Canvas.Rectangle(0, 0, Width, Height);
- ImgLstColors.Add(Bitmap, nil);
- MenuItem := TMenuItem.Create(ppColors);
- MenuItem.Caption := '颜色' + IntToStr(iLoop);
- MenuItem.Tag := StrToInt(ColorStr);
- MenuItem.ImageIndex := ImgLstColors.Count - 1;
- MenuItem.OnClick := miColorClick;
- MenuItem.Enabled := MenuItem.Tag <> UIMainColor;
- MenuItem.Checked := MenuItem.Tag = UIMainColor;
- if MenuItem.Checked then
- MenuItem.ImageIndex := -1;
- ppColors.Items.Insert(0, MenuItem);
- end;
- finally
- Bitmap.Free;
- end;
- miSkins.Clear;
- //FindSkins(ExtractFilePath(Application.ExeName) + 'Skins\');
- FindSkins(ExtractFilePath(Application.ExeName) + SkinPath);
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.ChangePPMenuColorMap(PopupMenuEx: TCustomActionPopupMenuEx);
- begin
- HideUserCardForm;
- PopupMenuEx.ColorMap.Color := FormColor;
- PopupMenuEx.ColorMap.SelectedColor := ConvertColorToColor(PopupMenuEx.ColorMap.SelectedColor, UIMainColor);
- PopupMenuEx.ColorMap.BtnFrameColor := ConvertColorToColor(PopupMenuEx.ColorMap.BtnFrameColor, UIMainColor);
- PopupMenuEx.Font.Name := '宋体';
- PopupMenuEx.Font.Size := 9;
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.ppContacterViewStyleGetControlClass(Sender: TCustomActionBar; AnItem: TActionClient; var ControlClass: TCustomActionControlClass);
- begin
- ChangePPMenuColorMap(ppContacterViewStyle.PopupMenu);
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.ppLoginedUsersGetControlClass(Sender: TCustomActionBar; AnItem: TActionClient; var ControlClass: TCustomActionControlClass);
- begin
- ChangePPMenuColorMap(ppLoginedUsers.PopupMenu);
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.ppLoginedUsersPopup(Sender: TObject);
- var
- iLoop: Integer;
- MenuItem: TMenuItem;
- begin
- while ppLoginedUsers.Items.Count > 2 do
- ppLoginedUsers.Items.Delete(0);
- for iLoop := 0 to RealICQClient.LoginedUsers.Count - 1 do
- begin
- if iLoop >= 20 then
- Break;
- MenuItem := TMenuItem.Create(ppLoginedUsers);
- MenuItem.AutoHotkeys := maManual;
- MenuItem.AutoLineReduction := maManual;
- MenuItem.Caption := RealICQClient.LoginedUsers[iLoop];
- MenuItem.OnClick := miChangeLoginNameClick;
- MenuItem.Tag := iLoop;
- ppLoginedUsers.Items.Insert(0, MenuItem);
- end;
- end;
- procedure TMainForm.ppLoginStatesGetControlClass(Sender: TCustomActionBar; AnItem: TActionClient; var ControlClass: TCustomActionControlClass);
- begin
- ChangePPMenuColorMap(ppLoginStates.PopupMenu);
- end;
- procedure TMainForm.ppMainMenuGetControlClass(Sender: TCustomActionBar; AnItem: TActionClient; var ControlClass: TCustomActionControlClass);
- begin
- ChangePPMenuColorMap(ppMainMenu.PopupMenu);
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.ppNetWorkFileGetControlClass(Sender: TCustomActionBar; AnItem: TActionClient; var ControlClass: TCustomActionControlClass);
- begin
- ChangePPMenuColorMap(ppNetWorkFile.PopupMenu);
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.ppNetWorkFilePopup(Sender: TObject);
- begin
- NDSelectItemChanged(nil);
- miNDNewDir.Enabled := spbNDNewDir.Enabled;
- miNDDelete.Enabled := spbNDDelete.Enabled;
- miNDDownload.Enabled := spbNDDownload.Enabled;
- miNDRename.Enabled := (FLVNetWorkDisk.SelCount = 1) and (not pnlNDMissions.Visible);
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.ppNetWorkMissonGetControlClass(Sender: TCustomActionBar; AnItem: TActionClient; var ControlClass: TCustomActionControlClass);
- begin
- ChangePPMenuColorMap(ppNetWorkMisson.PopupMenu);
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.ppNetWorkMissonPopup(Sender: TObject);
- begin
- if PageControlNDMission.ActivePageIndex = 0 then
- miNDCancel.Enabled := FLVNetWorkDiskUploadingFiles.SelCount > 0
- else
- miNDCancel.Enabled := FLVNetWorkDiskDownloadingFiles.SelCount > 0;
- end;
- procedure TMainForm.ppSelCallTelGetControlClass(Sender: TCustomActionBar; AnItem: TActionClient; var ControlClass: TCustomActionControlClass);
- begin
- ChangePPMenuColorMap(ppSelCallTel.PopupMenu);
- end;
- procedure TMainForm.ppServerListGetControlClass(Sender: TCustomActionBar; AnItem: TActionClient; var ControlClass: TCustomActionControlClass);
- begin
- ChangePPMenuColorMap(ppServerList.PopupMenu);
- end;
- procedure TMainForm.MeasureItem(Sender: TObject; ACanvas: TCanvas; var Width, Height: Integer);
- begin
-
- //在OnMeasureItem事件中改变菜单的宽度和高度
- //改变菜单的宽度和高度以容纳文本
- Width := edServerList.Width;
- end;
- procedure TMainForm.miChangeServerClick(Sender: TObject);
- var
- ServerInfo: TServerInfo;
- ItemIndex: Integer;
- RealICQContacterTreeView: TRealICQContacterTreeView;
- begin
- try
- SetGetMoreUserEvent;
- if Sender = nil then
- begin
- //RealICQClient.SendGetMoreBranch(FCurrentServerID);
- RealICQClient.SendGetBranchs(FCurrentServerID, 0);
- end
- else
- begin
- ServerInfo := FServerInfoList.Objects[FServerInfoList.IndexOf((Sender as TMenuItem).Hint)] as TServerInfo;
- if ServerInfo.ServerName = edServerList.Text then
- Exit;
- ItemIndex := FContacterTreeViews.IndexOf(LVMoreUsers);
- if ItemIndex >= 0 then
- begin
- RealICQContacterTreeView := FContacterTreeViews.Objects[ItemIndex] as TRealICQContacterTreeView;
- try
- RealICQContacterTreeView.Clear;
- FreeAndNil(RealICQContacterTreeView);
- FContacterTreeViews.Delete(ItemIndex);
- except
- //Exit;
- end;
- end;
- ImgLoadingMoreBranchs.Visible := True;
- ScrollBoxMoreUser.Visible := False;
- edServerList.Text := ServerInfo.ServerName;
- //RealICQClient.SendGetMoreBranch(ServerInfo.ServerId);
- RealICQClient.SendGetBranchs(ServerInfo.ServerId, 0);
- FCurrentServerID := ServerInfo.ServerId;
- end;
- except
- edServerList.Text := '';
- end;
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.ppTeamListViewGetControlClass(Sender: TCustomActionBar; AnItem: TActionClient; var ControlClass: TCustomActionControlClass);
- begin
- ChangePPMenuColorMap(ppTeamListView.PopupMenu);
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.ppTeamListViewPopup(Sender: TObject);
- var
- iLoop: Integer;
- RealICQTeam: TRealICQTeam;
- ListItem: TRealICQContacterListItem;
- begin
- actSendTeamMessage.Visible := FLVTeams.SelCount = 1;
- actSeeTeamInformation.Visible := FLVTeams.SelCount = 1;
- actShowTeamHistory.Visible := FLVTeams.SelCount = 1;
- actQuitTeam.Visible := FLVTeams.SelCount = 1;
- actDisbandTeam.Visible := FLVTeams.SelCount = 1;
- actQuitOrDisbandTeams.Visible := FLVTeams.SelCount > 1;
- self.miSendTeamSMS.Visible := FLVTeams.SelCount = 1;
- if FLVTeams.SelCount = 1 then
- begin
- for iLoop := 0 to FLVTeams.Items.Count - 1 do
- begin
- ListItem := FLVTeams.Items.Objects[iLoop] as TRealICQContacterListItem;
- if ListItem.Selected then
- begin
- RealICQTeam := ListItem.Data;
- actDisbandTeam.Visible := AnsiSameText(RealICQTeam.TeamCreater, RealICQClient.LoginName);
- actQuitTeam.Visible := not actDisbandTeam.Visible;
- if actDisbandTeam.Visible then
- actSeeTeamInformation.Caption := '修改群组详细资料(&D)...'
- else
- actSeeTeamInformation.Caption := '查看群组详细资料(&D)...';
- Break;
- end;
- end;
- end;
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.ppTrayIconGetControlClass(Sender: TCustomActionBar; AnItem: TActionClient; var ControlClass: TCustomActionControlClass);
- begin
- ChangePPMenuColorMap(ppTrayIcon.PopupMenu);
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.ppUserItemRightMenuGetControlClass(Sender: TCustomActionBar; AnItem: TActionClient; var ControlClass: TCustomActionControlClass);
- begin
- ChangePPMenuColorMap(ppUserItemRightMenu.PopupMenu);
- end;
- //------------------
- function TMainForm.GetActiveTabSheetName: string;
- //var ImageButton:TRealICQHoverImage;
- begin
- if ActiveButtonTag < 1 then
- ActiveButtonTag := 1;
- // ImageButton:=FToolBarButtonIconList.Objects[ActiveButtonTag-1] as TRealICQHoverImage;
- Result := FToolBarButtonIconList[ActiveButtonTag - 1];
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.ppUserItemRightMenuPopup(Sender: TObject);
- var
- iLoop, ItemIndex: Integer;
- GroupName, TabSheetName: string;
- Friend: TRealICQEmployee;
- MenuItem: TMenuItem;
- RealICQContacterTreeView: TRealICQContacterTreeView;
- RealICQFriendTreeView: TRealICQContacterTreeView;
- procedure SetMenuItemVisible;
- begin
- actSendMessage.Visible := actSendMessage.Enabled;
- actSeeInformation.Visible := actSeeInformation.Enabled;
- actShowHistory.Visible := actShowHistory.Enabled;
- actChangeRemark.Visible := actChangeRemark.Enabled;
- actDelFriend.Visible := actDelFriend.Enabled;
- actRemoveUser.Visible := actRemoveUser.Enabled;
- miGoSpace.Enabled := ShowSNS and actSendMessage.Enabled;
- // miGroup.Visible := miGroup.Enabled;
- end;
- begin
- miGoSpace.Visible := ShowSNS;
- RealICQContacterTreeView := nil;
- RealICQFriendTreeView := nil;
- TabSheetName := GetActiveTabSheetName;
- //如果是在“最近联系人”中弹出右键菜单
- if TabSheetName = LVLatests then
- begin
- actSendMessage.Enabled := FLVLatests.SelCount = 1;
- actSeeInformation.Enabled := FLVLatests.SelCount = 1;
- actShowHistory.Enabled := FLVLatests.SelCount = 1;
- actChangeRemark.Enabled := False;
- actDelFriend.Enabled := False;
- actRemoveUser.Enabled := False;
- // miGroup.Enabled := False;
- // miManageGroup.Enabled := False;
- // miManageGroup.Visible := False;
- // menuItemShowGroup.Visible := False;
- miGoSpace.Enabled := ShowSNS and actSendMessage.Enabled;
- SetMenuItemVisible;
- Exit;
- end;
- actSendMessage.Enabled := False;
- miGoSpace.Enabled := ShowSNS and actSendMessage.Enabled;
- actSeeInformation.Enabled := False;
- ;
- actShowHistory.Enabled := False;
- actChangeRemark.Enabled := False;
- actRemoveUser.Enabled := False;
- actDelFriend.Enabled := False;
- // miGroup.Enabled := False;
- // miManageGroup.Enabled := False;
- // miManageGroup.Visible := False;
- // menuItemShowGroup.Visible := False;
- if TabSheetName = LVMyContacters then
- begin
- ItemIndex := FContacterTreeViews.IndexOf(LVMyContacters);
- RealICQContacterTreeView := FContacterTreeViews.Objects[ItemIndex] as TRealICQContacterTreeView;
- if (RealICQContacterTreeView.GetSelectedEmployee <> nil) then
- begin
- actSendMessage.Enabled := True;
- miGoSpace.Enabled := ShowSNS and actSendMessage.Enabled;
- actSeeInformation.Enabled := True;
- actShowHistory.Enabled := True;
- actChangeRemark.Enabled := True;
- // miGroup.Enabled := False;
- actRemoveUser.Enabled := False;
- actDelFriend.Enabled := False;
- end;
- SetMenuItemVisible;
- Exit;
- end;
- if TabSheetName = LVMoreUsers then
- begin
- ItemIndex := FContacterTreeViews.IndexOf(LVMoreUsers);
- RealICQContacterTreeView := FContacterTreeViews.Objects[ItemIndex] as TRealICQContacterTreeView;
- if (RealICQContacterTreeView.GetSelectedEmployee <> nil) then
- begin
- actSendMessage.Enabled := True;
- miGoSpace.Enabled := ShowSNS and actSendMessage.Enabled;
- actSeeInformation.Enabled := True;
- actShowHistory.Enabled := True;
- actChangeRemark.Enabled := True;
- // miGroup.Enabled := False;
- actRemoveUser.Enabled := False;
- actDelFriend.Enabled := False;
- end;
- SetMenuItemVisible;
- Exit;
- end;
- ItemIndex := FContacterTreeViews.IndexOf(LVFriends);
- RealICQFriendTreeView := FContacterTreeViews.Objects[ItemIndex] as TRealICQContacterTreeView;
- Friend := RealICQFriendTreeView.GetSelectedEmployee;
- // miManageGroup.Enabled := True;
- // miManageGroup.Visible := True;
- // menuItemShowGroup.Visible := True;
- if Friend <> nil then
- begin
- GroupName := Friend.BranchID;
- if GroupName = LvFriends then
- actDelFriend.Enabled := True;
- actSendMessage.Enabled := True;
- miGoSpace.Enabled := ShowSNS and actSendMessage.Enabled;
- actSeeInformation.Enabled := True;
- actShowHistory.Enabled := True;
- actChangeRemark.Enabled := True;
- // miGroup.Enabled := True and (not FSearchListViewInVisible);
- actRemoveUser.Enabled := True;
- SetMenuItemVisible;
- end
- else
- begin
- SetMenuItemVisible;
- Exit;
- end;
- if AnsiSameStr(GroupName, LVFriends) then
- begin
- // miGroup.Caption := '移动至组(&M)...';
- actRemoveUser.Enabled := False;
- end
- else
- begin
- //在自定义组的用户列表控件上弹出右键菜单
- actSendMessage.Enabled := True;
- miGoSpace.Enabled := ShowSNS and actSendMessage.Enabled;
- actSeeInformation.Enabled := True;
- actShowHistory.Enabled := True;
- actChangeRemark.Enabled := True;
- // miGroup.Enabled := True and (not FSearchListViewInVisible);
- // miGroup.Caption := '移动至组(&M)...';
- end;
- // miGroup.Clear;
- if FShowGroup then
- begin
- for iLoop := 0 to FGroups.Count - 1 do
- begin
- if GroupName = FGroups[iLoop] then
- continue;
- // MenuItem := TMenuItem.Create(miGroup);
- // MenuItem.Caption := FGroups[iLoop];
- // MenuItem.OnClick := miMoveGroupClick;
- // MenuItem.Enabled := miGroup.Enabled;
- // miGroup.Add(MenuItem);
- end;
- // MenuItem := TMenuItem.Create(miGroup);
- // MenuItem.Caption := '-';
- // miGroup.Add(MenuItem);
- end;
- // miGroup.Enabled := miGroup.Count > 0;
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.WMQueryEndSession(var message: TWMQUERYENDSESSION);
- begin
- try
- try
- //Dialogs.ShowMessage('关机');
- FreeAndNil(NotReadMessageBoxForm);
- Application.Terminate;
- if RealICQClient.Logined then
- RealICQClient.Logout;
- except
- end;
- finally
- message.Result := 1; //允许
- end;
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.WMPowerBroadcast(var message: TMessage);
- begin
- try
- try
- if message.wparam = 4 then //..休眠
- begin
- if RealICQClient.Logined then
- RealICQClient.Logout;
- end;
- if message.wparam = 18 then // 休眠重起
- begin
- if RealICQClient.SavedPassword then
- RealICQClient.LoginAsSaved;
- end;
- except
- end;
- finally
- message.Result := 1; //允许
- end;
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.CMWininichange(var Message: TWMWinIniChange);
- begin
- ChangeUIColor(FUIMainColor);
- //TMainFormController.GetController.ChangeUIColor(UIMainColor);
- DisableAlign;
- try
- PostMessage(Handle, WM_SIZE, 0, 0);
- finally
- EnableAlign;
- end;
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.SetSearchListViewVisible(AShow: Boolean);
- begin
- FSearchListViewInVisible := AShow;
- if AShow then
- begin
- pnlSearch.Left := shpFilterBorder.Left + 9;
- pnlSearch.Top := shpFilterBorder.Top + shpFilterBorder.Height + 28;
- pnlSearch.Width := shpFilterBorder.Width;
- pnlSearch.Visible := True;
- end
- else
- begin
- pnlSearch.Visible := False;
- end;
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.edFilterKeywordChange(Sender: TObject);
- var
- iLoop: Integer;
- RealICQUser: TRealICQUser;
- KeyWord, UserCaption: string;
- ItemIndex: Integer;
- ListItem: TRealICQContacterListItem;
- AUsers: TStringList;
- begin
- KeyWord := Trim(edFilterKeyword.Text);
- if (KeyWord = '查找联系人...') or (KeyWord = '') then
- begin
- if FSearchListViewInVisible then
- SetSearchListViewVisible(False);
- end
- else
- begin
- if not FSearchListViewInVisible then
- SetSearchListViewVisible(True);
- if AnsiSameText(KeyWord, FLastSearchKeyWord) then
- Exit;
- //删除当前结果中不符合新的查询条件的记录
- FLastSearchKeyWord := KeyWord;
- for iLoop := FSearchListView.Items.Count - 1 downto 0 do
- begin
- if not AnsiSameText(Trim(edFilterKeyword.Text), KeyWord) then
- Exit;
- ListItem := FSearchListView.Items.Objects[iLoop] as TRealICQContacterListItem;
- RealICQUser := ListItem.Data;
- UserCaption := RealICQUser.DisplayName + '' + RealICQUser.LoginName + '' + RealICQUser.Watchword;
- if (AnsiPos(UpperCase(KeyWord), UpperCase(UserCaption)) = 0) and (AnsiPos(UpperCase(KeyWord), GetPYIndexString(RealICQUser.LoginName)) = 0) and (AnsiPos(UpperCase(KeyWord), GetPYIndexString(RealICQUser.DisplayName)) = 0) and (AnsiPos(UpperCase(KeyWord), GetPYIndexString(RealICQUser.Watchword)) = 0) then
- FSearchListView.Items.Delete(iLoop);
- Application.ProcessMessages;
- end;
- FSearchListView.FlashCaptionOnOnline := False;
- //在好友列表中查找
- AUsers := TUsersService.GetUsersService.GetWorkmatesAndFriends;
- try
- for iLoop := 0 to AUsers.Count - 1 do
- begin
- if not AnsiSameText(FLastSearchKeyWord, KeyWord) then
- begin
- Exit;
- end;
- RealICQUser := AUsers.Objects[iLoop] as TRealICQUser;
- if (RealICQUser = RealICQClient.Me) then
- continue;
- UserCaption := RealICQUser.DisplayName + ' ' + RealICQUser.LoginName + ' ' + RealICQUser.Watchword;
- if (AnsiPos(UpperCase(KeyWord), UpperCase(UserCaption)) > 0) or (AnsiPos(UpperCase(KeyWord), GetPYIndexString(RealICQUser.LoginName)) > 0) or (AnsiPos(UpperCase(KeyWord), GetPYIndexString(RealICQUser.DisplayName)) > 0) or (AnsiPos(UpperCase(KeyWord), GetPYIndexString(RealICQUser.Watchword)) > 0) then
- begin
- ItemIndex := FSearchListView.Items.IndexOf(RealICQUser.LoginName);
- if ItemIndex = -1 then
- begin
- ItemIndex := FSearchListView.Items.Add(RealICQUser.LoginName);
- ListItem := FSearchListView.Items.Objects[ItemIndex] as TRealICQContacterListItem;
- //BindUserDataToItem(ListItem, RealICQUser);
- TUsersService.GetUsersService.UpdateListItem(FSearchListView, ListItem, RealICQUser);
- Application.ProcessMessages;
- end;
- end;
- end;
- finally
- FreeAndNil(AUsers);
- end;
- FSearchListView.FlashCaptionOnOnline := FFlashCaptionOnOnline;
- if FSearchListView.Items.Count <= 0 then
- begin
- ScrollBoxSearchUser.Visible := False;
- lblSearchResult.Caption := #10 + #13 + ' 无搜索结果';
- lblSearchResult.Visible := True;
- end
- else
- begin
- ScrollBoxSearchUser.Visible := True;
- lblSearchResult.Visible := False;
- end;
- end;
- end;
- procedure TMainForm.edFilterKeywordClick(Sender: TObject);
- var
- KeyWord: string;
- begin
- KeyWord := Trim(edFilterKeyword.Text);
- if KeyWord = '查找联系人...' then
- edFilterKeyword.Text := '';
- edFilterKeyword.Font.Color := clWindowText;
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.edFilterKeywordExit(Sender: TObject);
- var
- KeyWord: string;
- begin
- KeyWord := Trim(edFilterKeyword.Text);
- if KeyWord = '' then
- edFilterKeyword.Text := '查找联系人...';
- edFilterKeyword.Font.Color := clGray;
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.SetLoginStateControlState;
- const
- CA_TEXT: string = '您选择了使用CA登录';
- begin
- try
- if (FLoginState = stLeave) or (FLoginState = stBusy) then
- spbLoginState.Caption := FLeaveMessage
- else
- spbLoginState.Caption := StateValues[Integer(FLoginState)];
- RealICQClient.LoginState := FLoginState;
- RealICQClient.LeaveMessage := FLeaveMessage;
- // RealICQClient.Me.LoginState := FLoginState;
- // RealICQClient.Me.LeaveMessage := FLeaveMessage;
- if FSavePassword then
- ImgLstCheckStates.GetIcon(1, spbSavePassword.Icon)
- else
- ImgLstCheckStates.GetIcon(0, spbSavePassword.Icon);
- if RealICQClient.CaEnable then
- begin
- if RealICQClient.CALogin then
- begin
- ImgLstCheckStates.GetIcon(1, btnCaLogin.Icon);
- edLoginName.Text := CA_TEXT;
- edLoginName.Enabled := False;
- edPassword.Enabled := False;
- spbChangeLoginName.Enabled := False;
- end
- else
- begin
- ImgLstCheckStates.GetIcon(0, btnCaLogin.Icon);
- if SameText(CA_TEXT, edLoginName.Text) then
- edLoginName.Text := '';
- edLoginName.Enabled := True;
- edPassword.Enabled := True;
- spbChangeLoginName.Enabled := True;
- end;
- end;
- FAutoLogin := FAutoLogin and FSavePassword;
- spbAutoLogin.Enabled := FSavePassword;
- if FAutoLogin then
- ImgLstCheckStates.GetIcon(1, spbAutoLogin.Icon)
- else
- ImgLstCheckStates.GetIcon(0, spbAutoLogin.Icon);
- except
- on E: Exception do
- begin
- Error(E.Message, 'TMainForm.SetLoginStateControlState');
- end;
- end;
- //ShowMeInformation;
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.edLoginNameChange(Sender: TObject);
- begin
- if AnsiSameText(edLoginName.Text, RealICQClient.LoginName) and RealICQClient.SavedPassword then
- begin
- edPassword.Text := '保存的密码';
- lblPasswordTitle.Enabled := False;
- edPassword.Enabled := False;
- spbSavePassword.Enabled := False;
- FLoginAsSavePassword := True;
- FLoginState := RealICQClient.LoginState;
- FLeaveMessage := RealICQClient.LeaveMessage;
- FSavePassword := RealICQClient.SavedPassword;
- FAutoLogin := RealICQClient.AutoLogin;
- SetLoginStateControlState;
- end
- else if FLoginAsSavePassword then
- begin
- edPassword.Text := '';
- edPassword.Enabled := True;
- lblPasswordTitle.Enabled := True;
- spbSavePassword.Enabled := True;
- FLoginAsSavePassword := False;
- FLoginState := stOnline;
- FLeaveMessage := '';
- FSavePassword := False;
- FAutoLogin := False;
- SetLoginStateControlState;
- end;
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.edPasswordEnter(Sender: TObject);
- begin
- if not RealICQClient.CALogin then
- begin
- Self.FSavePassword := True;
- // FAutoLogin := True;
- RealICQClient.AutoLogin := FAutoLogin;
- SetLoginStateControlState;
- end;
- end;
- //------全市查找-----------------------------
- procedure TMainForm.edtSearchMoreUserChange(Sender: TObject);
- var
- KeyWord: string;
- iIndex, iLoop: Integer;
- //FSearchMoreUserListView:TRealICQContacterListView;
- begin
- KeyWord := Trim((Sender as TEdit).Text);
- iIndex := FContacterListViews.IndexOf(LVMoreUsers);
- FSearchMoreUserListView := FContacterListViews.Objects[iIndex] as TRealICQContacterListView;
- FSearchMoreUserListView.Items.Clear;
- if (KeyWord = '查找联系人...') or (KeyWord = '') then
- begin
- pnlSearchMoreUser.Visible := False;
- Exit;
- end
- else
- begin
- RealICQClient.OnSearchUserResult := RealICQClientSearchUserResult;
- RealICQClient.SendSearchMoreUser(KeyWord, FCurrentServerID);
- pnlSearchMoreUser.Left := shpSearchMoreUser.Left;
- pnlSearchMoreUser.Width := pnlSelectServer.Width - 22;
- pnlSearchMoreUser.Top := shpSearchMoreUser.Top + shpSearchMoreUser.Height;
- LblSearchHint.Caption := #10 + #10 + #10 + #10 + #10'正在查询,请稍侯。';
- LblSearchHint.Visible := True;
- ScrollBoxSearchMoreUser.Visible := False;
- ImgLogining.Visible := True;
- pnlSearchMoreUser.Visible := True;
- pnlSearchMoreUser.BringToFront;
- end;
- end;
- //--------------------------------------------------------
- procedure TMainForm.edtSearchMoreUserClick(Sender: TObject);
- var
- KeyWord: string;
- begin
- KeyWord := Trim(edtSearchMoreUser.Text);
- if KeyWord = '查找联系人...' then
- edtSearchMoreUser.Text := '';
- edtSearchMoreUser.Font.Color := clWindowText;
- end;
- procedure TMainForm.edtSearchMoreUserExit(Sender: TObject);
- var
- KeyWord: string;
- begin
- KeyWord := Trim(edtSearchMoreUser.Text);
- if KeyWord = '' then
- edtSearchMoreUser.Text := '查找联系人...';
- edtSearchMoreUser.Font.Color := clGray;
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.edWatchwordExit(Sender: TObject);
- var
- AWatchword: WideString;
- begin
- spbWatchword.Visible := True;
- shpWatchwordBorder.Visible := False;
- edWatchword.Visible := False;
- if RealICQClient.Logined then
- begin
- if (not AnsiSameStr(Trim(edWatchword.Text), RealICQClient.Me.Watchword)) and (not AnsiSameStr(Trim(edWatchword.Text), '在此键入您的个性签名')) then
- begin
- AWatchword := Trim(edWatchword.Text);
- spbWatchword.Hint := AWatchword;
- spbWatchword.ShowHint := False;
-
- //字符串长度过长时,截短字符串并在后面显示“...”
- while spbWatchword.Canvas.TextWidth(AWatchword) > pnlTop.Width - 86 do
- begin
- if Length(AWatchword) > 3 then
- begin
- if Copy(AWatchword, Length(AWatchword) - 2, Length(AWatchword)) = '...' then
- AWatchword := Copy(AWatchword, 1, Length(AWatchword) - 3);
- AWatchword := Copy(AWatchword, 1, Length(AWatchword) - 1) + '...';
- end
- else
- break;
- spbWatchword.ShowHint := True;
- end;
- spbWatchword.Caption := edWatchword.Text;
- RealICQClient.ChangeBaseInformation(RealICQClient.Me.DisplayName, Trim(edWatchword.Text));
- end;
- end;
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.edWatchwordKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
- begin
- if Key = 13 then
- edWatchwordExit(edWatchword);
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.edWebSearchKeyWordEnter(Sender: TObject);
- begin
- //
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.edWebSearchKeyWordExit(Sender: TObject);
- begin
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.edWebSearchKeyWordKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
- begin
- if Key = 13 then
- spbWebSearchClick(nil);
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.spbWatchwordClick(Sender: TObject);
- begin
- if not RealICQClient.Logined then
- Exit;
- spbWatchword.Visible := False;
- shpWatchwordBorder.Left := spbWatchword.Left;
- shpWatchwordBorder.Top := spbWatchword.Top;
- shpWatchwordBorder.Width := pnlTop.Width - 66;
- shpWatchwordBorder.Height := spbWatchword.Height;
- edWatchword.Left := shpWatchwordBorder.Left + 2;
- edWatchword.Top := shpWatchwordBorder.Top + (shpWatchwordBorder.Height - edWatchword.Height) div 2 + 1;
- edWatchword.Width := shpWatchwordBorder.Width - 6;
- edWatchword.Text := RealICQClient.Me.Watchword;
- shpWatchwordBorder.Visible := True;
- edWatchword.Visible := True;
- edWatchword.SetFocus;
- edWatchword.SelStart := 0;
- edWatchword.SelLength := Length(edWatchword.Text);
- shpWatchwordBorder.BringToFront;
- edWatchword.BringToFront;
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.spbWebSearchClick(Sender: TObject);
- begin
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.spbWinMeetClick(Sender: TObject);
- var
- WinMeetPath, Parameter: string;
- Branch: TRealICQBranch;
- ItemIndex: Integer;
- RealICQContacterTreeView: TRealICQContacterTreeView;
- begin
- ItemIndex := MainForm.ContacterTreeViews.IndexOf(LVMoreUsers);
- if (ItemIndex < 0) then
- Exit;
- RealICQContacterTreeView := FContacterTreeViews.Objects[ItemIndex] as TRealICQContacterTreeView;
- ItemIndex := RealICQContacterTreeView.BranchItems.IndexOf(MainForm.RealICQClient.Me.BranchID);
- if (ItemIndex < 0) then
- Exit;
- Branch := RealICQContacterTreeView.BranchItems.Objects[ItemIndex] as TRealICQBranch;
- while Branch.Node.Parent <> nil do
- begin
- Branch := TRealICQBranch(Branch.Node.Parent.Data);
- end;
- WinMeetPath := GetFilePahtFromRegedit('\Software\WinSoft\WinMeet', 'AppPath');
- if Trim(WinMeetPath) = '' then
- begin
- ShowMessage('您还没有安装视频会议客户端！');
- Exit;
- end;
- Parameter := ' ' + MainForm.RealICQClient.LoginName + ' ' + MD5En(RealICQClient.Password) + ' ' + Branch.BranchID;
- ShellExecute(handle, 'open', PChar(WinMeetPath), PChar(Parameter), '', SW_SHOWNORMAL);
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.CreateParams(var Params: TCreateParams);
- begin
- inherited;
- //Inherited CreateParams(Params);
- with Params do
- begin
- Params.WndParent := 0;
- //Params.WndParent := GetDesktopWindow();
- end;
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.WndProc(var Message: TMessage);
- begin
- inherited wndproc(message);
- if message.msg = WM_DEVICECHANGE then
- RealICQClient.CheckAVDevice;
- if message.msg = CLOSEWINDOWS then
- QuitWindows;
- // if (message.msg = WM_WINDOWPOSCHANGING) then
- // pnlGroups.Refresh;
- // Debug('WM_WINDOWPOSCHANGING','WM_WINDOWPOSCHANGING');
- // if (message.msg = WM_WINDOWPOSCHANGED) then
- // pnlGroups.Refresh;
- // Debug('WM_WINDOWPOSCHANGED','WM_WINDOWPOSCHANGED');
- //(Handle, WM_PRINTCLIENT, 0, 0);
- {if (message.msg = WM_PAINT) or (message.msg = WM_NCPAINT) then
- begin
- ActionMainMenuBar.Refresh;
- end;}
-
end;
- procedure TMainForm.spbAddToNAClick(Sender: TObject);
- var
- TabSheet: TTabSheet;
- WebBrowser: TWebBrowser;
- begin
- MainForm.FormStyle := fsNormal;
- try
- try
- TabSheet := pgcMultiWeb.ActivePage;
- WebBrowser := (TabSheet.Controls[0] as TPanel).Controls[0] as TWebBrowser;
- AddToFavorite(WebBrowser);
- except
- end;
- finally
- // if MainForm.AlwaysOnTop then
- // MainForm.FormStyle := fsStayOnTop
- // else
- // MainForm.FormStyle := fsNormal;
-
end;
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.spbWebCloseClick(Sender: TObject);
- var
- TabSheet: TTabSheet;
- WebBrowser: TWebBrowser;
- begin
- TabSheet := pgcMultiWeb.ActivePage;
- WebBrowser := (TabSheet.Controls[0] as TPanel).Controls[0] as TWebBrowser;
- if pgcMultiWeb.PageCount > 1 then
- begin
- try
- if WebBrowser.Busy then
- WebBrowser.Stop;
- except
- end;
- TabSetMuiltWeb.Tabs.Delete(TabSheet.TabIndex);
- TabSheet.PageControl := nil;
- FreeAndNil(TabSheet);
- end
- else
- begin
- WebBrowser.OnDocumentComplete := WebBrowserRightDocumentComplete;
- WebBrowser.Navigate('about:blank');
- end;
- end;
- procedure TMainForm.spbAutoLoginClick(Sender: TObject);
- begin
- FAutoLogin := not FAutoLogin;
- RealICQClient.AutoLogin := FAutoLogin;
- SetLoginStateControlState;
- end;
- procedure TMainForm.HideMainForm;
- begin
- if FMovingMainForm then
- Exit;
- if RealICQClient.Logining then
- Exit;
- PostMessage(Handle, WM_KILLFOCUS, 0, 0);
- self.SendToBack;
- FMainFormHidden := True;
- end;
- procedure TMainForm.ShowMainForm;
- begin
- if FMovingMainForm then
- Exit;
- self.BringToFront;
- PostMessage(Handle, WM_SETFOCUS, 0, 0);
- FMainFormHidden := False;
- end;
- procedure TMainForm.WMSizing(var Msg: TMessage);
- begin
- inherited;
- HideUserCardForm;
- FMovingMainForm := True;
- end;
- procedure TMainForm.WMSize(var Msg: TMessage);
- begin
- inherited;
- HideUserCardForm;
- FMovingMainForm := False;
- //CheckWindowPositon;
- end;
- procedure TMainForm.WMMoving(var Msg: TWMMoving);
- var
- BaseTop, BaseLeft: Integer;
- rect:TRect;
- begin
- inherited;
- HideUserCardForm;
- FMovingMainForm := True;
- rect.Left := 1;
- rect.Top := 1;
- rect.Bottom := Screen.Height - 1;
- rect.Right := Screen.Width - 1;
- Windows.ClipCursor(@rect);
- BaseTop := (Height - ClientHeight) div 4;
- BaseLeft := (Width - ClientWidth) div 4;
- if (Msg.DragRect^.Top < -BaseTop) then
- FHidePosition := hpTop
- else if (Msg.DragRect^.Left < -BaseLeft) then
- FHidePosition := hpLeft
- else if (Msg.DragRect^.Left > (Screen.WorkAreaWidth - Width + BaseLeft)) then
- FHidePosition := hpRight
- else
- FHidePosition := hpNone;
- end;
- procedure TMainForm.WMMove(var Msg: TMessage);
- begin
- HideUserCardForm;
- FMovingMainForm := False;
- Windows.ClipCursor(0);
- if not FAutoHide then
- exit;
- if FWindowMoveing then
- exit;
- case FHidePosition of
- hpTop:
- WindowMove(False, -ClientHeight);
- hpLeft:
- WindowMove(False, -ClientWidth);
- hpRight:
- WindowMove(False, (Screen.WorkAreaWidth - Width + ClientWidth));
- end;
- if FHidePosition <> hpNone then
- SetOnTop(Handle, True)
- else
- if not FAlwaysOnTop then
- SetOnTop(Handle, False);
- end;
- procedure TMainForm.WMNCMouseMove(var msg: TWMNCMousemove);
- var
- BaseTop, BaseLeft, BaseRight: Integer;
- begin
- inherited;
- if not FAutoHide then
- exit;
- if FWindowMoveing then
- exit;
- case FHidePosition of
- hpTop:
- case msg.HitTest of
- HTBOTTOMLEFT, HTBOTTOM, HTBOTTOMRIGHT:
- begin
- BaseTop := (Height - ClientHeight) div 2;
- if Top < -BaseTop then
- begin
- WindowMove(True, -BaseTop);
- TimerForHideMainForm.Enabled := True;
- end;
- end;
- end;
- hpLeft:
- case msg.HitTest of
- HTTOPRIGHT, HTRIGHT, HTBOTTOMRIGHT:
- begin
- BaseLeft := (Width - ClientWidth) div 2;
- if Left < -BaseLeft then
- begin
- WindowMove(True, -BaseLeft);
- TimerForHideMainForm.Enabled := True;
- end;
- end;
- end;
- hpRight:
- case msg.HitTest of
- HTTOPLEFT, HTLEFT, HTBOTTOMLEFT:
- begin
- BaseLeft := (Width - ClientWidth) div 2;
- BaseRight := Screen.WorkAreaWidth - ClientWidth - BaseLeft;
- if Left > BaseRight then
- begin
- WindowMove(True, BaseRight);
- TimerForHideMainForm.Enabled := True;
- end;
- end;
- end;
- end;
- end;
- procedure TMainForm.WindowMove(blnShow: Boolean; iBase: Integer);
- begin
- FWindowMoveing := true;
- DisableAlign;
- if not pnlLogout.Visible then
- pnlWorkArea.Visible := False;
- if blnShow then
- begin
- case FHidePosition of
- hpTop:
- begin
- ANimateWindow(Handle, 20, AW_HIDE or AW_VER_POSITIVE);
- sleep(10);
- Top := iBase;
- ANimateWindow(Handle, 300, AW_SLIDE or AW_VER_POSITIVE);
- end;
- hpLeft:
- begin
- ANimateWindow(Handle, 20, AW_HIDE or AW_HOR_POSITIVE);
- sleep(10);
- left := iBase;
- ANimateWindow(Handle, 300, AW_SLIDE or AW_HOR_POSITIVE);
- end;
- hpRight:
- begin
- ANimateWindow(Handle, 20, AW_HIDE or AW_HOR_NEGATIVE);
- sleep(10);
- left := iBase;
- ANimateWindow(Handle, 300, AW_SLIDE or AW_HOR_NEGATIVE);
- end;
- end;
- end
- else
- begin
- case FHidePosition of
- hpTop:
- begin
- ANimateWindow(Handle, 300, AW_HIDE or AW_VER_NEGATIVE);
- sleep(10);
- Top := iBase;
- ANimateWindow(Handle, 20, AW_VER_NEGATIVE);
- end;
- hpLeft:
- begin
- ANimateWindow(Handle, 300, AW_HIDE or AW_HOR_NEGATIVE);
- sleep(10);
- Left := iBase;
- ANimateWindow(Handle, 20, AW_HOR_NEGATIVE);
- end;
- hpRight:
- begin
- ANimateWindow(Handle, 300, AW_HIDE or AW_HOR_POSITIVE);
- sleep(10);
- Left := iBase;
- ANimateWindow(Handle, 20, AW_HOR_POSITIVE);
- end;
- end;
- end;
- if not pnlLogout.Visible then
- pnlWorkArea.Visible := true;
- EnableAlign;
- FWindowMoveing := false;
- end;
- procedure TMainForm.TimerForHideMainFormTimer(Sender: TObject);
- var
- Rect: TRect;
- begin
- if FMovingMainForm then
- Exit;
- if FWindowMoveing then
- exit;
- if not FAutoHide then
- begin
- if FMainFormHidden then
- ShowMainForm;
- FHidePosition := hpNone;
- TimerForHideMainForm.Enabled := False;
- Exit;
- end;
- //搜狗输入法冲突
- // if FHidePosition <> hpNone then
- // SetOnTop(Handle,True);
- TimerForHideMainForm.Enabled := false;
- Rect.Top := self.Top;
- Rect.Left := self.Left;
- Rect.Right := self.Left + self.Width;
- Rect.Bottom := self.Top + self.Height;
- if not PtInRect(Rect, Mouse.CursorPos) then
- begin
- case FHidePosition of
- hpTop:
- if Top <> -ClientHeight then
- WindowMove(False, -ClientHeight);
- hpLeft:
- if Left <> -ClientWidth then
- WindowMove(False, -ClientWidth);
- hpRight:
- if Left <> Screen.WorkAreaWidth - Width + ClientWidth then
- WindowMove(False, (Screen.WorkAreaWidth - Width + ClientWidth));
- end;
- end;
- TimerForHideMainForm.Enabled := FHidePosition <> hpNone;
- end;
- procedure TMainForm.CheckWindowPositon;
- var
- BaseTop, BaseLeft: Integer;
- begin
- BaseTop := (Height - ClientHeight) div 4;
- BaseLeft := (Width - ClientWidth) div 4;
- if (Top < -BaseTop) then
- FHidePosition := hpTop
- else if (Left < -BaseLeft) then
- FHidePosition := hpLeft
- else if (Left > (Screen.WorkAreaWidth - Width + BaseLeft)) then
- FHidePosition := hpRight
- else
- FHidePosition := hpNone;
- if TimerForHideMainForm <> nil then
- TimerForHideMainForm.Enabled := FHidePosition <> hpNone;
- end;
- //------------------------------------------------------------------------------
-
procedure TMainForm.spbCancelFilterClick(Sender: TObject);
- begin
- edFilterKeyword.Text := '查找联系人...';
- edFilterKeyword.Font.Color := clGray;
- end;
- procedure TMainForm.spbChangeLoginNameClick(Sender: TObject);
- var
- Point: TPoint;
- begin
- Point.X := 0;
- Point.Y := spLoginNameBorder.Height + 1;
- Point := spLoginNameBorder.ClientToScreen(Point);
- ppLoginedUsers.Popup(Point.X, Point.Y);
- end;
- procedure TMainForm.spbContacterViewStyleClick(Sender: TObject);
- var
- Point: TPoint;
- begin
- Point.X := 0;
- Point.Y := spbContacterViewStyle.Height + 1;
- Point := spbContacterViewStyle.ClientToScreen(Point);
- ppContacterViewStyle.Popup(Point.X, Point.Y);
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.spbDisplayNameClick(Sender: TObject);
- var
- Point: TPoint;
- begin
- Point.X := 0;
- Point.Y := spbDisplayName.Height + 1;
- Point := spbDisplayName.ClientToScreen(Point);
- ppChangeStates.Popup(Point.X, Point.Y);
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.spbEmailClick(Sender: TObject);
- begin
- //AddWebBrowserToPageControl('http://www.lxtalk.com/rd/', 999);
-
end;
- procedure TMainForm.spbFindTeamClick(Sender: TObject);
- begin
- //非办公助手企业用户无查找群组权限
- if (FProductType <> ptBGZS) AND ((FUserType = utUnknown) OR (FUserType = utCompany)) then
- begin
- ShowMessage('您没有查找群组权限! ');
- Exit;
- end;
- if SearchTeamForm <> nil then
- begin
- SearchTeamForm.BringToFront;
- Exit;
- end;
- SearchTeamForm := TSearchTeamForm.Create(Application);
- SearchTeamForm.Show;
- end;
- procedure TMainForm.spbGoClick(Sender: TObject);
- var
- TabSheet: TTabSheet;
- WebBrowser: TWebBrowser;
- begin
- TabSheet := pgcMultiWeb.ActivePage;
- WebBrowser := (TabSheet.Controls[0] as TPanel).Controls[0] as TWebBrowser;
- WebBrowser.Tag := -1;
- try
- if (WebBrowser.Busy) then
- WebBrowser.Stop;
- except
- end;
- WebBrowser.OnDocumentComplete := WebBrowserRightDocumentComplete;
- WebBrowser.Navigate(cbxURLInputer.Text);
- end;
- //------------------------------------------------------------------------------
-
procedure TMainForm.spbLoginStateClick(Sender: TObject);
- var
- Point: TPoint;
- begin
- Point.X := 0;
- Point.Y := spbLoginState.Height + 1;
- Point := spbLoginState.ClientToScreen(Point);
- ppLoginStates.Popup(Point.X, Point.Y);
- end;
- procedure TMainForm.spbNDCancelAllClick(Sender: TObject);
- var
- AMissionID: string;
- UploadMission: TUploadMission;
- ListItem: TRealICQContacterListItem;
- begin
- try
- if (FLVNetWorkDiskUploadingFiles <> nil) and (FLVNetWorkDiskUploadingFiles.Items.Count > 0) then
- begin
- ListItem := FLVNetWorkDiskUploadingFiles.Items.Objects[0] as TRealICQContacterListItem;
- if Assigned(ListItem) then
- begin
- UploadMission := TUploadMission(ListItem.Data);
- if Assigned(UploadMission) then
- begin
- AMissionID := UploadMission.FID;
- try
- FLVNetWorkDiskUploadingFiles.Items.Delete(ListItem.ItemIndex);
- FreeAndNil(UploadMission);
- except
- end;
- RealICQNetWorkDiskClient.CancelUploadingFile(AMissionID);
- end;
- end;
- end;
- except
- end;
- try
- if FLVNetWorkDiskUploadingFiles <> nil then
- begin
- FLVNetWorkDiskUploadingFiles.Items.Clear;
- FLVNetWorkDiskUploadingFiles.ReDrawAll;
- end;
- except
- end;
- try
- if FLVNetWorkDiskDownloadingFiles <> nil then
- begin
- FLVNetWorkDiskDownloadingFiles.Items.Clear;
- FLVNetWorkDiskDownloadingFiles.ReDrawAll;
- end;
- except
- end;
- ClearFileMissions;
- pnlNDMissions.Visible := False;
- SplitterNDMissions.Visible := False;
- spbNDCancelAll.Enabled := False;
- FConfirmReplaceResult := -1;
- FLastDownloadDirectory := '';
- CheckNDControlState;
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.spbNDConnectClick(Sender: TObject);
- var
- LoginName: string;
- begin
- RealICQNetWorkDiskClient.TCPClient.RemoteAddress := RealICQClient.NetWorkDiskServerAddress;
- RealICQNetWorkDiskClient.TCPClient.RemotePort := RealICQClient.NetWorkDiskServerPort;
- RealICQNetWorkDiskClient.TCPClient.Proxy.Assign(RealICQClient.TCPClient.Proxy);
- LoginName := RealICQClient.LoginName;
- if Pos('+', RealICQClient.LoginName) > 0 then
- LoginName := Copy(RealICQClient.LoginName, Pos('+', RealICQClient.LoginName) + 1, Length(RealICQClient.LoginName));
- RealICQNetWorkDiskClient.Login(LoginName, RealICQClient.Password);
- end;
- procedure TMainForm.spbSavePasswordClick(Sender: TObject);
- begin
- FSavePassword := not FSavePassword;
- SetLoginStateControlState;
- end;
- procedure TMainForm.spbSelectServerClick(Sender: TObject);
- var
- Point: TPoint;
- begin
- Point.X := 0;
- Point.Y := spServerListBorder.Height;
- Point := spServerListBorder.ClientToScreen(Point);
- ppServerList.Popup(Point.X, Point.Y);
- end;
- procedure TMainForm.spbSelLanguageClick(Sender: TObject);
- var
- Point: TPoint;
- begin
- Point.X := 0;
- Point.Y := (Sender as TRealICQSpeedButton).Height + 1;
- Point := (Sender as TRealICQSpeedButton).ClientToScreen(Point);
- ppLanguages.Popup(Point.X, Point.Y);
- end;
- procedure TMainForm.spbSelUIColorClick(Sender: TObject);
- var
- Point: TPoint;
- begin
- Point.X := 0;
- Point.Y := (Sender as TRealICQSpeedButton).Height + 1;
- Point := (Sender as TRealICQSpeedButton).ClientToScreen(Point);
- ppColors.Popup(Point.X, Point.Y);
- end;
- procedure TMainForm.spbShowHideRightClick(Sender: TObject);
- begin
- //ShowOrHideMuiltiWeb;
- end;
- procedure TMainForm.spbStopClick(Sender: TObject);
- var
- TabSheet: TTabSheet;
- WebBrowser: TWebBrowser;
- begin
- try
- TabSheet := pgcMultiWeb.ActivePage;
- WebBrowser := (TabSheet.Controls[0] as TPanel).Controls[0] as TWebBrowser;
- if WebBrowser.Busy then
- WebBrowser.Stop;
- except
- end;
- end;
- procedure TMainForm.TabSetMuiltWebClick(Sender: TObject);
- var
- TabSheet: TTabSheet;
- WebBrowser: TWebBrowser;
- begin
- pgcMultiWeb.ActivePageIndex := TabSetMuiltWeb.TabIndex;
- try
- TabSheet := pgcMultiWeb.ActivePage;
- WebBrowser := (TabSheet.Controls[0] as TPanel).Controls[0] as TWebBrowser;
- if not AnsiSameText(WebBrowser.LocationURL, 'about:blank') then
- begin
- with cbxURLInputer.ItemsEx.Add do
- begin
- Caption := WebBrowser.LocationURL;
- if (Copy(Caption, 1, 5) = 'file:') or (Copy(Caption, 2, 1) = ':') then
- ImageIndex := 2
- else if Copy(Caption, 1, 4) = 'ftp:' then
- ImageIndex := 1
- else
- ImageIndex := 0;
- end;
- cbxURLInputer.ItemIndex := cbxURLInputer.ItemsEx.Count - 1;
- end;
- except
- end;
- end;
-
procedure TMainForm.TabSetMuiltWebGetImageIndex(Sender: TObject; TabIndex: Integer; var ImageIndex: Integer);
- var
- TabSheet: TTabSheet;
- WebBrowser: TWebBrowser;
- AImageIndex: Integer;
- begin
- AImageIndex := 0;
- try
- TabSheet := pgcMultiWeb.Pages[TabIndex];
- WebBrowser := (TabSheet.Controls[0] as TPanel).Controls[0] as TWebBrowser;
- if not AnsiSameText(WebBrowser.LocationURL, 'about:blank') then
- begin
- with cbxURLInputer.ItemsEx.Add do
- begin
- Caption := WebBrowser.LocationURL;
- if (Copy(Caption, 1, 5) = 'file:') or (Copy(Caption, 2, 1) = ':') then
- ImageIndex := 2
- else if Copy(Caption, 1, 4) = 'ftp:' then
- ImageIndex := 1
- else
- ImageIndex := 0;
- AImageIndex := ImageIndex;
- end;
- cbxURLInputer.ItemIndex := cbxURLInputer.ItemsEx.Count - 1;
- end;
- except
- end;
- ImageIndex := AImageIndex;
- end;
- procedure TMainForm.TabSetNDMissionsChange(Sender: TObject; NewTab: Integer; var AllowChange: Boolean);
- begin
- PageControlNDMission.ActivePageIndex := TabSetNDMissions.TabIndex;
- end;
- procedure TMainForm.TabSetNDMissionsClick(Sender: TObject);
- begin
- PageControlNDMission.ActivePageIndex := TabSetNDMissions.TabIndex;
- end;
- procedure TMainForm.TimerForCheckDblClickTimer(Sender: TObject);
- begin
- TimerForCheckDblClick.Enabled := False;
- SetForegroundWindow(TrueHiddenMainForm.Handle);
- if RealICQClient.Logined and RealICQClient.Connected then
- ppChangeStates.Popup(FCursorPosX, Screen.WorkAreaHeight)
- else
- ppTrayIcon.Popup(FCursorPosX, Screen.WorkAreaHeight);
- end;
- procedure TMainForm.TimerForCheckLogoutTimeoutTimer(Sender: TObject);
- begin
- TimerForCheckLogoutTimeout.Enabled := False;
- RealICQClient.Logout;
- SetUIState;
- end;
- procedure TMainForm.TrayIconClick(Sender: TObject);
- begin
- FCursorPosX := Mouse.CursorPos.X;
- TimerForCheckDblClick.Interval := GetDoubleClickTime();
- if not TimerForCheckDblClick.Enabled then
- TimerForCheckDblClick.Enabled := True;
- end;
- procedure TMainForm.OpenNotReadMessage(iIndex: Integer);
- var
- nTeamID: string;
- MessageID, SMSReceiver: string;
- SystemMessage: TRealICQSystemMessage;
- SMSForm: TSMSForm;
- MessageList: TList;
- NotReadMessage: TNotReadMessage;
- begin
- if (iIndex < 0) and (iIndex >= FNotReadMessages.Count) then
- Exit;
- if FNotReadMessages.Count = 0 then
- actOpenMainForm.Execute
- else
- begin
- MessageID := FNotReadMessages.Strings[iIndex];
- if AnsiSameStr(Copy(MessageID, 1, Length(SMSMessageID)), SMSMessageID) then
- begin
- SMSReceiver := Copy(MessageID, Length(SMSMessageID) + 1, Length(MessageID) - Length(SMSMessageID));
- // if SMSReceiver <> '' then
-
SMSForm := OpenSMSForm(SMSReceiver)
- // else
- // SMSForm := OpenSMSForm()
-
end
- else if AnsiSameStr(Copy(MessageID, 1, Length(TeamMessageID)), TeamMessageID) then
- begin
- nTeamID := Copy(MessageID, Length(TeamMessageID) + 1, Length(MessageID) - Length(TeamMessageID));
- OpenTeamTalkingForm(nTeamID);
- end
- else if AnsiSameStr(Copy(MessageID, 1, Length(SystemMessageID)), SystemMessageID) then
- begin
- try
- SystemMessage := FNotReadMessages.Objects[iIndex] as TRealICQSystemMessage;
- ShowSystemMessage(SystemMessage);
- finally
- FNotReadMessages.Delete(iIndex);
- try
- NotReadMessageBoxForm.ShowNotReadMessage;
- NotReadMessageBoxForm.Height := 0;
- NotReadMessageBoxForm.Top := Screen.WorkAreaHeight - NotReadMessageBoxForm.Height;
- except
- end;
- end;
- end
- else
- begin
- MessageList := FNotReadMessages.Objects[iIndex] as TList;
- NotReadMessage := MessageList[0];
- OpenTalkingForm(MessageID, True, NotReadMessage.FRealICQClient);
- end;
- end;
- end;
- procedure TMainForm.TrayIconDblClick(Sender: TObject);
- var
- BaseTop, BaseLeft: Integer;
- begin
- TimerForCheckDblClick.Enabled := False;
- OpenNotReadMessage(FNotReadMessages.Count - 1);
- if FHidePosition <> hpNone then
- begin
- TimerForHideMainForm.Enabled := False;
- FHidePosition := hpNone;
- BaseTop := (Height - ClientHeight) div 4;
- BaseLeft := (Width - ClientWidth) div 4;
- Self.Top := 0;
- Self.left := Screen.WorkAreaWidth - Width;
- if not FAlwaysOnTop then
- SetOnTop(Handle, False);
- end;
- end;
- procedure TMainForm.TrayIconMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
- var
- iTimes: Integer;
- ANeedShow: Boolean;
- rcTray: TRect;
- hwndTray: hWnd;
- hwndChild: hWnd;
- begin
- try
- if not Assigned(NotReadMessageBoxForm) then
- Exit;
- ANeedShow := (FNotReadMessages <> nil) and (FNotReadMessages.Count > 0) and (MainForm.RealICQClient.Connected) and (TimerForFlashTrayIcon.Enabled);
- if not ANeedShow then
- begin
- if NotReadMessageBoxForm.Visible then
- begin
- NotReadMessageBoxForm.Visible := False;
- NotReadMessageBoxForm.Timer1.Enabled := False;
- end;
- Exit;
- end;
- if (not NotReadMessageBoxForm.Visible) and (NotReadMessageBoxForm.Tag = 1) then
- begin
- //TrayIcon.Hint := '';
-
NotReadMessageBoxForm.Tag := 0;
- hwndTray := FindWindow('Shell_TrayWnd', nil);
- hwndChild := FindWindowEx(hwndTray, 0, 'TrayNotifyWnd', nil);
- GetWindowRect(hwndChild, rcTray);
- FTrayIconRect.Left := X - 20;
- FTrayIconRect.Top := rcTray.Top;
- FTrayIconRect.Right := FTrayIconRect.Left + 40;
- FTrayIconRect.Bottom := rcTray.Bottom;
- NotReadMessageBoxForm.ShowNotReadMessage;
- NotReadMessageBoxForm.Height := 0;
- NotReadMessageBoxForm.FRect := FTrayIconRect;
- //NotReadMessageBoxForm.Left := X - NotReadMessageBoxForm.Width div 2;
-
NotReadMessageBoxForm.Left := Screen.WorkAreaWidth - NotReadMessageBoxForm.Width;
- NotReadMessageBoxForm.Top := Screen.WorkAreaHeight - NotReadMessageBoxForm.Height;
- NotReadMessageBoxForm.FRect.Left := NotReadMessageBoxForm.FRect.Left;
- NotReadMessageBoxForm.FRect.Top := NotReadMessageBoxForm.Top;
- NotReadMessageBoxForm.FRect.Right := NotReadMessageBoxForm.FRect.Right;
- NotReadMessageBoxForm.FRect.Bottom := NotReadMessageBoxForm.FRect.Bottom;
- NotReadMessageBoxForm.Visible := True;
- NotReadMessageBoxForm.Timer1.Enabled := True;
- end;
- //MessageBoxForm.Visible := FNotReadMessages.Count > 0;
-
except
- end;
- end;
- procedure TMainForm.TrayIconMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
- begin
- //if AutoUpdateForm <> nil then Exit;
-
if Button = mbRight then
- begin
- SetForegroundWindow(TrueHiddenMainForm.Handle);
- self.BringToFront;
- ppTrayIcon.Popup(Mouse.CursorPos.X, Screen.WorkAreaHeight);
- end;
- end;
- //------------------------------------------------------------------------------
- {通讯录}
- //------------------------------------------------------------------------------
- procedure TMainForm.tsAddrBookShow(Sender: TObject);
- begin
- //
- end;
- //----保存联系人----------------------------------------------------- ---------
- procedure TMainForm.SaveContacter(Name, Mobile, Tel, Email, Remark, BranchId: string);
- var
- MessageId, ParamValue: string;
- begin
- MessageId := IntToStr(GetTickCount);
- CreateManageGroupMemberMessage('', Name, '', Mobile, Tel, Email, Remark, BranchId, MessageId);
- //发送新增联系人消息
-
ParamValue := MessageId + #10 + '' + #10 + Name + #10 + Mobile + #10 + Tel + #10 + Email + #10 + Remark + #10 + '' + #10 + BranchId;
- RealICQClient.SendAddrBookCommand(1, 1, ParamValue);
- end;
- //----修改备注名称--------------------------------------------------------------
-
procedure TMainForm.miSendTeamSMSClick(Sender: TObject);
- var
- iLoop: Integer;
- ListItem: TRealICQContacterListItem;
- RealICQTeam: TRealICQTeam;
- begin
- if not MainForm.RealICQClient.UserPermission.EnableMultiSendSms then
- begin
- ShowMessage('您没有短信群发权限！');
- Exit;
- end;
- if FLVTeams.SelCount = 1 then
- begin
- for iLoop := 0 to FLVTeams.Items.Count - 1 do
- begin
- ListItem := FLVTeams.Items.Objects[iLoop] as TRealICQContacterListItem;
- if ListItem.Selected then
- begin
- RealICQTeam := ListItem.Data;
- OpenTeamSMSForm(RealICQTeam.TeamID);
- Break;
- end;
- end;
- end;
- end;
- procedure TMainForm.miSetRemarkClick(Sender: TObject);
- var
- LoginName: string;
- Remark, MessageId, ParamValue: string;
- RealICQUser: TRealICQUser;
- Employee: TRealICQEmployee;
- RealICQContacterTreeView: TRealICQContacterTreeView;
- ItemIndex: Integer;
- begin
- ItemIndex := MainForm.ContacterTreeViews.IndexOf(LVAddrBook);
- RealICQContacterTreeView := MainForm.ContacterTreeViews.Objects[ItemIndex] as TRealICQContacterTreeView;
- Employee := RealICQContacterTreeView.GetSelectedEmployee;
- LoginName := Employee.LoginName;
- if LoginName <> '' then
- begin
- RealICQUser := GetAddrBookUser(Employee.BranchID, LoginName);
- if RealICQUser = nil then
- Exit;
- Remark := RealICQUser.Remark;
- Remark := Trim(ShowMyInputBox('修改备注名称', '新备注名称', RealICQUser.Remark, 50));
- if not AnsiSameStr(Remark, RealICQUser.Remark) then//发送修改备注
- begin
- MessageId := IntToStr(GetTickCount);
- CreateManageGroupMemberMessage(RealICQUser.LoginName, RealICQUser.DisplayName, RealICQUser.Remark, RealICQUser.Mobile, RealICQUser.Tel, RealICQUser.Email, Remark, Employee.BranchID, MessageId);
- //发送修改联系人消息
- RealICQUser.Remark := Remark;
- LoginName := Employee.LoginName;
- LoginName := Copy(LoginName, Pos('-', LoginName) + 1, Length(LoginName) - Pos('-', LoginName));
- ParamValue := MessageId + #10 + LoginName + #10 + RealICQUser.DisplayName + #10 + RealICQUser.Mobile + #10 + RealICQUser.Tel + #10 + RealIcqUser.Email + #10 + RealICQUser.Watchword + #10 + Remark + #10 + Employee.BranchId;
- MainForm.RealICQClient.SendAddrBookCommand(6, 1, ParamValue);
- end;
- end;
- end;
-
procedure TMainForm.miAddGroupClick(Sender: TObject);
- var
- ItemIndex, iLoop: Integer;
- RealICQContacterTreeView: TRealICQContacterTreeView;
- TmpBranch: TRealICQBranchInfo;
- Branch: TRealICQBranch;
- GroupName, ResultStr, SelBranchName: string;
- ParamValue: string;
- MessageId: string;
- BranchNames, TmpList: TStringList;
- Employee: TRealICQEmployee;
- begin
- ItemIndex := MainForm.ContacterTreeViews.IndexOf(LVAddrBook);
- RealICQContacterTreeView := MainForm.ContacterTreeViews.Objects[ItemIndex] as TRealICQContacterTreeView;
- Branch := RealICQContacterTreeView.GetSelectedBranch;
- if Branch = nil then
- begin
- Employee := RealICQContacterTreeView.GetSelectedEmployee;
- if Employee <> nil then
- Branch := Employee.Node.Parent.Data;
- end;
- if Branch <> nil then
- SelBranchName := Branch.BranchName
- else
- SelBranchName := '我的通讯录';
- BranchNames := TStringList.Create;
- try
- for iLoop := 0 to MainForm.RealICQClient.AddrBookGroups.Count - 1 do
- begin
- TmpBranch := MainForm.RealICQClient.AddrBookGroups.Objects[iLoop] as TRealICQBranchInfo;
- GroupName := '';
- GetParentGroupNameList(TmpBranch, GroupName);
- BranchNames.AddObject(GroupName, TmpBranch);
- if TmpBranch.ID = Branch.BranchID then
- SelBranchName := GroupName;
- end;
- ResultStr := ShowAddrGroupInputBox('新建组', SelBranchName, BranchNames);
- if ResultStr = '' then
- exit;
- TmpList := SplitString(ResultStr, #10);
- GroupName := TmpList[1];
- if BranchNames.IndexOf(TmpList[0] + GroupName + '\') >= 0 then
- begin
- ShowMessage('已存在相同名称的组！');
- Exit;
- end;
- TmpBranch := BranchNames.Objects[BranchNames.IndexOf(TmpList[0])] as TRealICQBranchInfo;
- //发送添加通讯录组消息
- MessageId := IntToStr(GetTickCount);
- CreateManageGroupMessage(TmpBranch.ID, GroupName, TmpBranch.ParentID, MessageId);
- ParamValue := MessageId + #10 + GroupName + #10 + '0' + #10 + TmpBranch.ID + #10 + MainForm.RealICQClient.Me.LoginName;
- MainForm.RealICQClient.SendAddrBookCommand(1, 0, ParamValue);
- finally
- BranchNames.Free;
- end;
- end;
- procedure TMainForm.miUpdateGroupClick(Sender: TObject);
- var
- ItemIndex: Integer;
- RealICQContacterTreeView: TRealICQContacterTreeView;
- Branch: TRealICQBranch;
- GroupName, MessageId, ParamValue: string;
- begin
- ItemIndex := MainForm.ContacterTreeViews.IndexOf(LVAddrBook);
- RealICQContacterTreeView := MainForm.ContacterTreeViews.Objects[ItemIndex] as TRealICQContacterTreeView;
- Branch := RealICQContacterTreeView.GetSelectedBranch;
- if Branch <> nil then
- begin
- GroupName := Branch.BranchName;
- if GroupName = '我的通讯录' then
- begin
- ShowMessage('默认组不允许修改！');
- Exit;
- end;
- end
- else
- begin
- ShowMessage('请选择要修改的组！');
- Exit;
- end;
- GroupName := ShowMyInputBox('修改组', '组名称', GroupName, 500);
- if (GroupName <> Branch.BranchName) and (GroupName <> '') then
- begin
- //发送修改通讯录组名消息
-
MessageId := IntToStr(GetTickCount);
- CreateManageGroupMessage(Branch.BranchID, GroupName, Branch.ParentID, MessageId);
- ParamValue := MessageId + #10 + GroupName + #10 + Branch.BranchID + #10 + Branch.ParentID + #10 + MainForm.RealICQClient.Me.LoginName;
- MainForm.RealICQClient.SendAddrBookCommand(2, 0, ParamValue);
- end;
- end;
- //-----删除通讯录组----------------------------------------------------
-
procedure TMainForm.miDelGroupClick(Sender: TObject);
- var
- ItemIndex: Integer;
- RealICQContacterTreeView: TRealICQContacterTreeView;
- Branch: TRealICQBranch;
- GroupId: string;
- ParamValue: string;
- MessageId: string;
- begin
- ItemIndex := MainForm.ContacterTreeViews.IndexOf(LVAddrBook);
- RealICQContacterTreeView := MainForm.ContacterTreeViews.Objects[ItemIndex] as TRealICQContacterTreeView;
- Branch := RealICQContacterTreeView.GetSelectedBranch;
- GroupId := '';
- if Branch <> nil then
- begin
- if Branch.ParentID = '0' then
- begin
- ShowMessage('默认组不可以删除');
- Exit;
- end;
- if MessageBox(Handle, '确定要将选中的组删除吗？', '确认删除', MB_OKCANCEL or MB_ICONQUESTION) <> IDOK then
- Exit;
- //发送删除通讯录组消息
- MessageId := IntToStr(GetTickCount);
- GetChildsGroupId(Branch.BranchID, GroupId);
- CreateManageGroupMessage(GroupId, Branch.BranchName, Branch.ParentID, MessageId);
- ParamValue := MessageId + #10 + GroupId + #10 + Branch.BranchID + #10 + Branch.ParentID + #10 + MainForm.RealICQClient.Me.LoginName;
- MainForm.RealICQClient.SendAddrBookCommand(3, 0, ParamValue);
- end
- else
- ShowMessage('请选择要删除的组！');
- end;
- //-----新增用户到通讯录---------------------------------------
- procedure TMainForm.miAddGroupUserClick(Sender: TObject);
- var
- MessageId, ParamValue, BranchID: string;
- Branch: TRealICQBranch;
- TmpBranch: TRealICQBranchInfo;
- Employee: TRealICQEmployee;
- RealICQUser: TRealICQUser;
- Node: TTreeNode;
- ItemIndex, iLoop: Integer;
- BranchNames: TStringList;
- BranchName, GroupName: string;
- RealICQContacterTreeView: TRealICQContacterTreeView;
- begin
- BranchName := '我的通讯录\';
- ItemIndex := MainForm.ContacterTreeViews.IndexOf(LVAddrBook);
- RealICQContacterTreeView := MainForm.ContacterTreeViews.Objects[ItemIndex] as TRealICQContacterTreeView;
- Branch := RealICQContacterTreeView.GetSelectedBranch;
- if Branch = nil then
- begin
- Employee := RealICQContacterTreeView.GetSelectedEmployee;
- if Employee <> nil then
- begin
- Node := Employee.Node.Parent;
- Branch := Node.Data;
- end;
- end;
- if Branch <> nil then
- begin
- if Branch.BranchName = '我的通讯录' then
- begin
- ShowMessage('默认组下面不允许添加联系人！');
- Exit;
- end;
- BranchID := Branch.BranchID;
- end;
- if (GetGroupUserCount + 1) > MainForm.RealICQClient.UserPermission.AddrBookSize then
- begin
- ShowMessage('您的通讯录已满或者没有添加联系人的权限！' + #13 + '请联系系统管理员。');
- Exit;
- end;
- BranchNames := TStringList.Create;
- try
- for iLoop := 0 to MainForm.RealICQClient.AddrBookGroups.Count - 1 do
- begin
- TmpBranch := MainForm.RealICQClient.AddrBookGroups.Objects[iLoop] as TRealICQBranchInfo;
- GroupName := '';
- GetParentGroupNameList(TmpBranch, GroupName);
- if TmpBranch.ID = BranchID then
- BranchNames.InsertObject(0, GroupName, TmpBranch)
- else
- BranchNames.AddObject(GroupName, TmpBranch);
- end;
- //弹出新增联系人窗体
- RealICQUser := TRealICQUser.Create('', RealICQClient);
- if not ShowAddrUserInputBox('新增联系人', RealICQUser, BranchNames) then
- Exit;
- if Trim(RealICQUser.Nickname) = '' then
- Exit;
- MessageId := IntToStr(GetTickCount);
- CreateManageGroupMemberMessage('', RealICQUser.Nickname, RealICQUser.Remark, RealICQUser.Mobile, RealICQUser.Tel, RealICQUser.Email, RealICQUser.Remark1, BranchID, MessageId);
- //发送新增联系人消息
- ParamValue := MessageId + #10 + '' + #10 + RealICQUser.Nickname + #10 + RealICQUser.Mobile + #10 + RealICQUser.Tel + #10 + RealIcqUser.Email + #10 + RealICQUser.Remark1 + #10 + RealICQUser.Remark + #10 + BranchID;
- RealICQClient.SendAddrBookCommand(1, 1, ParamValue);
- finally
- BranchNames.Free;
- end;
- end;
- procedure TMainForm.miBusyClick(Sender: TObject);
- begin
- FLoginState := stBusy;
- FLeaveMessage := '忙碌';
- SetLoginStateControlState;
- end;
- procedure TMainForm.miUpdateGroupUserClick(Sender: TObject);
- var
- ItemIndex, iLoop: Integer;
- RealICQContacterTreeView: TRealICQContacterTreeView;
- Employee: TRealICQEmployee;
- BranchNames: TStringList;
- Branch: TRealICQBranch;
- RealICQUser: TRealICQUser;
- LoginName: string;
- ParamValue: string;
- MessageId: string;
- ParentNode: TTreeNode;
- begin
- ItemIndex := MainForm.ContacterTreeViews.IndexOf(LVAddrBook);
- RealICQContacterTreeView := MainForm.ContacterTreeViews.Objects[ItemIndex] as TRealICQContacterTreeView;
- Employee := RealICQContacterTreeView.GetSelectedEmployee;
- if Employee <> nil then
- begin
- //弹出修改窗体
- BranchNames := TStringList.Create;
- try
- for iLoop := 0 to RealICQContacterTreeView.BranchItems.Count - 1 do
- begin
- Branch := RealICQContacterTreeView.BranchItems.Objects[iLoop] as TRealICQBranch;
- if Branch.BranchID = Employee.BranchID then
- BranchNames.Insert(0, Branch.BranchName)
- else
- BranchNames.Add(Branch.BranchName);
- end;
- ParentNode := Employee.Node.Parent;
- Branch := ParentNode.Data;
- RealICQUser := GetAddrBookUser(Employee.BranchID, Employee.LoginName);
- if not ShowAddrUserInputBox('查看/编辑联系人', RealICQUser, BranchNames) then
- Exit;
- MessageId := IntToStr(GetTickCount);
- CreateManageGroupMemberMessage(RealICQUser.LoginName, RealICQUser.DisplayName, RealICQUser.Remark, RealICQUser.Mobile, RealICQUser.Tel, RealICQUser.Email, RealICQUser.Remark1, Employee.BranchID, MessageId);
- //发送修改联系人消息
- LoginName := Employee.LoginName;
- LoginName := Copy(LoginName, Pos('-', LoginName) + 1, Length(LoginName) - Pos('-', LoginName));
- ParamValue := MessageId + #10 + LoginName + #10 + RealICQUser.Nickname + #10 + RealICQUser.Mobile + #10 + RealICQUser.Tel + #10 + RealIcqUser.Email + #10 + RealICQUser.Remark1 + #10 + RealICQUser.Remark + #10 + Employee.BranchId;
- MainForm.RealICQClient.SendAddrBookCommand(2, 1, ParamValue);
- finally
- BranchNames.Free;
- end;
- end
- else
- ShowMessage('请选择要修改的联系人!');
- end;
- //----删除联系人-------------------------------------------------------------
- procedure TMainForm.miDelGroupUserClick(Sender: TObject);
- var
- ItemIndex: Integer;
- RealICQContacterTreeView: TRealICQContacterTreeView;
- Employee: TRealICQEmployee;
- ParamValue: string;
- MessageId, LoginName: string;
- begin
- ItemIndex := MainForm.ContacterTreeViews.IndexOf(LVAddrBook);
- RealICQContacterTreeView := MainForm.ContacterTreeViews.Objects[ItemIndex] as TRealICQContacterTreeView;
- Employee := RealICQContacterTreeView.GetSelectedEmployee;
- if Employee = nil then
- begin
- ShowMessage('请选择要删除的联系人');
- Exit
- end;
- //发送删除通讯录组联系人消息
- MessageId := IntToStr(GetTickCount);
- CreateManageGroupMemberMessage(Employee.LoginName, Employee.DisplayName, '', Employee.Mobile, '', '', '', Employee.BranchID, MessageId);
- LoginName := Employee.LoginName;
- LoginName := Copy(LoginName, Pos('-', LoginName) + 1, Length(LoginName) - Pos('-', LoginName));
- ParamValue := MessageId + #10 + LoginName + #10 + Employee.DisplayName + #10 + Employee.Mobile + #10 + '' + #10 + '' + #10 + '' + #10 + '' + #10 + Employee.BranchId;
- MainForm.RealICQClient.SendAddrBookCommand(3, 1, ParamValue);
- end;
- procedure TMainForm.spbExportGroupUserClick(Sender: TObject);
- var
- ItemIndex, iLoop, jLoop, IIndex: Integer;
- RealICQContacterTreeView: TRealICQContacterTreeView;
- Branch: TRealICQBranch;
- RealICQUser: TRealICQUser;
- BranchInfo: TRealICQBranchInfo;
- GroupId: string;
- begin
- SD.Title := '导出通讯录另存为';
- SD.Filter := 'CSV(*.csv)|*.csv';
- CsvLines := TStringList.Create;
- CommaStr := TStringList.Create;
- CommaStr.CommaText := '姓名 手机 电话 电子邮箱 备注';
- CsvLines.Add(CommaStr.CommaText);
- MainForm.RealICQClient.OnGettedAddrBookUsers := GettedAddrBookUsers1;
- ItemIndex := MainForm.ContacterTreeViews.IndexOf(LVAddrBook);
- if (ItemIndex < 0) then
- Exit;
- RealICQContacterTreeView := MainForm.ContacterTreeViews.Objects[ItemIndex] as TRealICQContacterTreeView;
- Branch := RealICQContacterTreeView.GetSelectedBranch;
- if Branch = nil then
- begin
- ShowMessage('请在通讯录中选择组！');
- Exit;
- end;
- if Branch.BranchName = '我的通讯录' then
- begin
- ShowMessage('默认组下面不允许导出联系人！');
- Exit;
- end;
- SD.FileName := Branch.BranchName + '.csv';
- GetChildsGroupId(Branch.BranchID, GroupId);
- MainForm.RealICQClient.ExAddrBookUsers.Clear;
- while Pos(',', GroupId) > 0 do
- begin
- IIndex := Pos(',', GroupId);
- MainForm.RealICQClient.SendGetAddrbookUser(Copy(GroupId, 1, IIndex - 1));
- sleep(200);
- Delete(GroupId, 1, IIndex);
- end;
- MainForm.RealICQClient.SendGetAddrbookUser(GroupId);
- if SD.Execute then
- begin
- CsvLines.SaveToFile(SD.FileName);
- end;
- CsvLines.Free;
- CommaStr.Free;
- end;
- procedure TMainForm.GettedAddrBookUsers1(Sender: TObject);
- var
- iLoop: integer;
- RealICQUser: TRealICQUser;
- BranchInfo: TRealICQBranchInfo;
- begin
- for iLoop := MainForm.RealICQClient.ExAddrBookUsers.Count - 1 downto 0 do
- begin
- RealICQUser := MainForm.RealICQClient.ExAddrBookUsers.Objects[iLoop] as TRealICQUser;
- CommaStr.CommaText := AnsiRePlaceStr(RealICQUser.DisplayName, ' ', '') + ',' + RealICQUser.Mobile + ',' + RealICQUser.Tel + ',' + RealICQUser.Email + ',' + RealICQUser.Remark1;
- CsvLines.Add(CommaStr.CommaText);
- end;
- MainForm.RealICQClient.ExAddrBookUsers.Clear;
- end;
- //-----导入联系人---------------------------------
-
procedure TMainForm.spbImportGroupUserClick(Sender: TObject);
- var
- ItemIndex: Integer;
- RealICQContacterTreeView: TRealICQContacterTreeView;
- Branch: TRealICQBranch;
- begin
- ItemIndex := MainForm.ContacterTreeViews.IndexOf(LVAddrBook);
- if (ItemIndex < 0) then
- Exit;
- RealICQContacterTreeView := MainForm.ContacterTreeViews.Objects[ItemIndex] as TRealICQContacterTreeView;
- Branch := RealICQContacterTreeView.GetSelectedBranch;
- if Branch = nil then
- begin
- ShowMessage('请在通讯录中选择组！');
- Exit;
- end;
- if ImportGuideFrom = nil then
- ImportGuideFrom := TImportGuideFrom.Create(self);
- ImportGuideFrom.SelBranch := Branch;
- ImportGuideFrom.Show;
- ForceForeGroundWindow(ImportGuideFrom.Handle);
- end;
- //-------------得到指定通讯录组的所有子节点ID-----------------------------------
-
procedure TMainForm.GetChildsGroupId(GroupId: string; var Groups: string);
- var
- iLoop: Integer;
- BranchInfo: TRealICQBranchInfo;
- begin
- if Groups <> '' then
- Groups := Groups + ',';
- Groups := Groups + GroupId;
- for iLoop := 0 to MainForm.RealICQClient.AddrBookGroups.Count - 1 do
- begin
- BranchInfo := MainForm.RealICQClient.AddrBookGroups.Objects[iLoop] as TRealICQBranchInfo;
- if BranchInfo.ParentID = GroupId then
- GetChildsGroupId(BranchInfo.ID, Groups);
- end;
- end;
-
procedure TMainForm.miCutClick(Sender: TObject);
- var
- ItemIndex: Integer;
- Employee: TRealICQEmployee;
- Branch: TRealICQBranch;
- RealICQContacterTreeView: TRealICQContacterTreeView;
- begin
- ItemIndex := MainForm.ContacterTreeViews.IndexOf(LVAddrBook);
- RealICQContacterTreeView := MainForm.ContacterTreeViews.Objects[ItemIndex] as TRealICQContacterTreeView;
- if FCutNode <> nil then
- begin
- if FCutNode.StateIndex = 0 then
- begin
- Branch := FCutNode.Data;
- Branch.IsCutState := False;
- Branch.Update;
- end
- else
- begin
- Employee := FCutNode.Data;
- Employee.IsCutState := False;
- Employee.Update;
- end;
- end;
- Employee := RealICQContacterTreeView.GetSelectedEmployee;
- if Employee <> nil then
- begin
- Employee.IsCutState := True;
- Employee.Update;
- FCutNode := Employee.Node;
- Exit;
- end;
- Branch := RealICQContacterTreeView.GetSelectedBranch;
- if Branch <> nil then
- begin
- if Branch.BranchName = '我的通讯录' then
- begin
- ShowMessage('默认组不允许剪切！');
- Exit;
- end;
- Branch.IsCutState := True;
- Branch.Update;
- FCutNode := Branch.Node;
- end;
- end;
- //---粘贴-----------------------------------------------------------------------
-
procedure TMainForm.miPasteClick(Sender: TObject);
- var
- ItemIndex, EmployeeCount, iLoop: Integer;
- MessageId, ParamValue, LoginName: string;
- Employee, TmpEmployee: TRealICQEmployee;
- SelBranch, TmpBranch, Branch: TRealICQBranch;
- RealICQContacterTreeView: TRealICQContacterTreeView;
- ParentNode: TTreeNode;
- RealICQUser: TRealICQUser;
- begin
- ItemIndex := MainForm.ContacterTreeViews.IndexOf(LVAddrBook);
- RealICQContacterTreeView := MainForm.ContacterTreeViews.Objects[ItemIndex] as TRealICQContacterTreeView;
- Employee := RealICQContacterTreeView.GetSelectedEmployee;
- if Employee <> nil then
- begin
- ItemIndex := RealICQContacterTreeView.BranchItems.IndexOf(Employee.BranchID);
- SelBranch := RealICQContacterTreeView.BranchItems.Objects[ItemIndex] as TRealICQBranch;
- end
- else
- SelBranch := RealICQContacterTreeView.GetSelectedBranch;
- if SelBranch = nil then
- Exit;
- if FCutNode.StateIndex = 0 then
- begin
- TmpBranch := FCutNode.Data;
- //判断同一级别是否存在相同的部门
-
for iLoop := 0 to RealICQContacterTreeView.BranchItems.Count - 1 do
- begin
- Branch := RealICQContacterTreeView.BranchItems.Objects[iLoop] as TRealICQBranch;
- if (Branch.ParentID = SelBranch.BranchID) and (Branch.BranchName = TmpBranch.BranchName) then
- begin
- ShowMessage('已存在名称相同的组！');
- TmpBranch.IsCutState := False;
- TmpBranch.Update;
- FCutNode := nil;
- Exit;
- end;
- end;
- ParentNode := TmpBranch.Node.Parent;
- TmpBranch.Node.MoveTo(SelBranch.Node, naAddChild);
- TmpBranch.ParentID := SelBranch.BranchID;
- TmpBranch.Node.Selected := True;
- TmpBranch.IsCutState := False;
- TmpBranch.Update;
- MessageId := IntToStr(GetTickCount);
- CreateManageGroupMessage(TmpBranch.BranchID, TmpBranch.BranchName, SelBranch.BranchID, MessageId);
- //发送修改组的父级ID
-
ParamValue := MessageId + #10 + TmpBranch.BranchName + #10 + TmpBranch.BranchID + #10 + SelBranch.BranchID + #10 + MainForm.RealICQClient.Me.LoginName;
- MainForm.RealICQClient.SendAddrBookCommand(4, 0, ParamValue);
- EmployeeCount := TmpBranch.EmployeeCount;
- while ParentNode <> nil do
- begin
- TmpBranch := ParentNode.Data;
- TmpBranch.EmployeeCount := TmpBranch.EmployeeCount - EmployeeCount;
- TmpBranch.Update;
- ParentNode := TmpBranch.Node.Parent;
- end;
- ParentNode := SelBranch.Node;
- while ParentNode <> nil do
- begin
- TmpBranch := ParentNode.Data;
- TmpBranch.EmployeeCount := TmpBranch.EmployeeCount + EmployeeCount;
- TmpBranch.Update;
- ParentNode := TmpBranch.Node.Parent;
- end;
- end
- else
- begin
- TmpEmployee := FCutNode.Data;
- if GetAddrBookUserIndex(SelBranch.BranchID, TmpEmployee.LoginName) >= 0 then
- begin
- ShowMessage('已存在名称相同的联系人！');
- TmpEmployee.IsCutState := False;
- TmpEmployee.Update;
- FCutNode := nil;
- Exit;
- end;
- MessageId := IntToStr(GetTickCount);
- CreateManageGroupMemberMessage(TmpEmployee.LoginName, TmpEmployee.DisplayName, '', TmpEmployee.Mobile, TmpEmployee.Tel, TmpEmployee.EmailHint, '', SelBranch.BranchID, MessageId);
- //发送修改联系人所属组消息
- LoginName := TmpEmployee.LoginName;
- LoginName := Copy(LoginName, Pos('-', LoginName) + 1, Length(LoginName) - Pos('-', LoginName));
- ParamValue := MessageId + #10 + LoginName + #10 + TmpEmployee.DisplayName + #10 + TmpEmployee.Mobile + #10 + '' + #10 + '' + #10 + TmpEmployee.BranchID + #10 + '' + #10 + SelBranch.BranchId;
- MainForm.RealICQClient.SendAddrBookCommand(5, 1, ParamValue);
- end;
- end;
- //----得到父级的所有组名称---------------------------------------------
-
procedure TMainForm.GetParentGroupNameList(BranchInfo: TRealICQBranchInfo; var Groups: string);
- var
- iLoop: Integer;
- TmpBranchInfo: TRealICQBranchInfo;
- begin
- Groups := BranchInfo.BranchName + '\' + Groups;
- for iLoop := 0 to MainForm.RealICQClient.AddrBookGroups.Count - 1 do
- begin
- TmpBranchInfo := MainForm.RealICQClient.AddrBookGroups.Objects[iLoop] as TRealICQBranchInfo;
- if BranchInfo.ParentID = TmpBranchInfo.ID then
- GetParentGroupNameList(TmpBranchInfo, Groups);
- end;
- end;
- //----创建管理组消息
-
procedure TMainForm.CreateManageGroupMessage(GroupId, GroupName, ParentId, MessageId: string);
- var
- ManageGroupMessage: TManageGroupMessage;
- begin
- ManageGroupMessage := TManageGroupMessage.Create;
- ManageGroupMessage.MessageId := MessageId;
- ManageGroupMessage.FGroupID := GroupId;
- ManageGroupMessage.FGroupName := GroupName;
- ManageGroupMessage.FParentID := ParentId;
- FManageGroupMsgList.AddObject(ManageGroupMessage.MessageId, ManageGroupMessage);
- end;
- //----创建管理联系人消息
-
procedure TMainForm.CreateManageGroupMemberMessage(ID, DisplayName, NickName, Mobile, Tel, Email, Remark, GroupId, MessageId: string);
- var
- ManageGroupMemberMessage: TManageGroupMemberMessage;
- begin
- ManageGroupMemberMessage := TManageGroupMemberMessage.Create;
- ManageGroupMemberMessage.MessageId := MessageId;
- ManageGroupMemberMessage.FID := Id;
- ManageGroupMemberMessage.FDisplayName := DisplayName;
- ManageGroupMemberMessage.FNickName := NickName;
- ManageGroupMemberMessage.FMobile := Mobile;
- ManageGroupMemberMessage.FTel := Tel;
- ManageGroupMemberMessage.FEmail := Email;
- ManageGroupMemberMessage.FRemark := Remark;
- ManageGroupMemberMessage.FGroupId := GroupId;
- FManageGroupMemberMsgList.AddObject(ManageGroupMemberMessage.MessageId, ManageGroupMemberMessage);
- end;
- //----------------------------------------------------------
-
procedure TMainForm.GettedManageAddrBookResult(Sender: TObject; OperatModal: Integer; OperatCommand: Integer; RetValue, MessageId: Cardinal);
- var
- Branch: TRealICQBranch;
- RealICQBranch: TRealICQBranchInfo;
- RealICQUser, TmpRealICQUser: TRealICQUser;
- TreeViewIndex, ItemIndex, iLoop, i, jLoop: Integer;
- RealICQContacterTreeView: TRealICQContacterTreeView;
- ManageGroupMessage: TManageGroupMessage;
- ManageGroupMemberMsg: TManageGroupMemberMessage;
- TmpList, TmpDelUsers: TStringList;
- Employee, TmpEmployee: TRealICQEmployee;
- ErrMsg, TmpUsers: string;
- begin
- try
- TreeViewIndex := MainForm.ContacterTreeViews.IndexOf(LVAddrBook);
- RealICQContacterTreeView := MainForm.ContacterTreeViews.Objects[TreeViewIndex] as TRealICQContacterTreeView;
- if RetValue = -1 then
- begin
- case OperatCommand of
- 1:
- ErrMsg := '新建';
- 2:
- ErrMsg := '修改';
- 3:
- ErrMsg := '删除';
- 4:
- ErrMsg := '批量添加';
- end;
- if OperatModal = 0 then
- begin
- if OperatCommand = 4 then
- ErrMsg := '粘贴';
- ErrMsg := ErrMsg + '组失败';
- end
- else
- begin
- ErrMsg := ErrMsg + '联系人失败';
- if OperatCommand = 5 then
- ErrMsg := '粘贴联系人失败';
- if OperatCommand = 6 then
- ErrMsg := '修改联系人备注失败';
- end;
- ShowMessage(ErrMsg);
- Exit;
- end;
- if OperatModal = 0 then //对组操作
- begin
- i := FManageGroupMsgList.IndexOf(IntToStr(MessageId));
- ManageGroupMessage := FManageGroupMsgList.Objects[i] as TManageGroupMessage;
- case OperatCommand of
- 1:
- begin //增加组
- Branch := TRealICQBranch.Create(ManageGroupMessage.FGroupName);
- Branch.BranchID := IntToStr(RetValue);
- Branch.ParentID := ManageGroupMessage.FGroupID;
- RealICQBranch := TRealICQBranchInfo.Create;
- RealICQBranch.ID := IntToStr(RetValue);
- RealICQBranch.ParentID := ManageGroupMessage.FGroupID;
- RealICQBranch.BranchName := ManageGroupMessage.FGroupName;
- RealICQContacterTreeView.AddBranch(Branch);
- MainForm.RealICQClient.AddrBookGroups.AddObject(RealICQBranch.ID, RealICQBranch);
- Branch.Node.Selected := True;
- end;
- 2:
- begin //修改组
- ItemIndex := RealICQContacterTreeView.BranchItems.IndexOf(ManageGroupMessage.FGroupID);
- Branch := RealICQContacterTreeView.BranchItems.Objects[ItemIndex] as TRealICQBranch;
- Branch.BranchName := ManageGroupMessage.FGroupName;
- Branch.Update;
- ItemIndex := MainForm.RealICQClient.AddrBookGroups.IndexOf(ManageGroupMessage.FGroupID);
- RealICQBranch := MainForm.RealICQClient.AddrBookGroups.Objects[ItemIndex] as TRealICQBranchInfo;
- RealICQBranch.BranchName := ManageGroupMessage.FGroupName;
- end;
- 3:
- begin //删除组
- try
- TmpList := SplitString(ManageGroupMessage.FGroupID, ',');
- for iLoop := 0 to TmpList.Count - 1 do
- begin
- ItemIndex := MainForm.RealICQClient.AddrBookGroups.IndexOf(TmpList[iLoop]);
- if ItemIndex >= 0 then
- begin
- MainForm.RealICQClient.AddrBookGroups.Delete(ItemIndex);
- ItemIndex := GetGroupUsers(TmpList[iLoop]);
- while ItemIndex >= 0 do
- begin
- MainForm.RealICQClient.AddrBookUsers.Delete(ItemIndex);
- ItemIndex := GetGroupUsers(TmpList[iLoop]);
- end;
- end;
- end;
- RealICQContacterTreeView.Clear;
- FreeAndNil(RealICQContacterTreeView);
- MainForm.ContacterTreeViews.Delete(TreeViewIndex);
- MainForm.AddContacterTreeView(ScrollBoxAddrBook, LVAddrBook);
- LoadAddrBook(ManageGroupMessage.FParentId);
- TreeViewIndex := MainForm.ContacterTreeViews.IndexOf(LVAddrBook);
- RealICQContacterTreeView := MainForm.ContacterTreeViews.Objects[TreeViewIndex] as TRealICQContacterTreeView;
- ItemIndex := RealICQContacterTreeView.BranchItems.IndexOf(ManageGroupMessage.FParentID);
- Branch := RealICQContacterTreeView.BranchItems.Objects[ItemIndex] as TRealICQBranch;
- while Branch.ParentID <> '0' do
- begin
- NodeGroupClick(nil, Branch);
- Branch := Branch.Node.Parent.Data;
- end;
- finally
- if TmpList <> nil then
- TmpList.Free;
- if TmpDelUsers <> nil then
- TmpDelUsers.Free;
- end;
- end;
- 4:
- begin //剪切粘贴
- ItemIndex := MainForm.RealICQClient.AddrBookGroups.IndexOf(ManageGroupMessage.FGroupID);
- RealICQBranch := MainForm.RealICQClient.AddrBookGroups.Objects[ItemIndex] as TRealICQBranchInfo;
- RealICQBranch.ParentID := ManageGroupMessage.FParentID;
- end;
- end;
- FManageGroupMsgList.Delete(i);
- end
- else //对联系人操作
- begin
- i := FManageGroupMemberMsgList.IndexOf(IntToStr(MessageId));
- ManageGroupMemberMsg := FManageGroupMemberMsgList.Objects[i] as TManageGroupMemberMessage;
- case OperatCommand of
- 1:
- begin //新增联系人
- ItemIndex := RealICQClient.AddrBookGroups.IndexOf(ManageGroupMemberMsg.FGroupId);
- RealICQBranch := RealICQClient.AddrBookGroups.Objects[ItemIndex] as TRealICQBranchInfo;
- RealICQBranch.EmployeeCount := RealICQBranch.EmployeeCount + 1;
- //---------------------------------------------
- RealICQUser := TRealICQUser.Create(IntToStr(RetValue), MainForm.RealICQClient);
- RealICQUser.LoginName := IntToStr(RetValue);
- RealICQUser.DisplayName := ManageGroupMemberMsg.FDisplayName;
- RealICQUser.Remark := ManageGroupMemberMsg.FNickName;
- RealICQUser.Mobile := ManageGroupMemberMsg.FMobile;
- RealICQUser.BranchID := ManageGroupMemberMsg.FGroupId;
- RealICQUser.Tel := ManageGroupMemberMsg.FTel;
- RealICQUser.Email := ManageGroupMemberMsg.FEmail;
- RealICQUser.Remark1 := ManageGroupMemberMsg.FRemark;
- MainForm.RealICQClient.AddrBookUsers.AddObject(RealICQUser.LoginName, RealICQUser);
- Employee := TRealICQEmployee.Create(RealICQUser.LoginName);
- Employee.BranchID := RealICQUser.BranchID;
- Employee.DisplayName := RealICQUser.DisplayName;
- Employee.Mobile := RealICQUser.Mobile;
- Employee.HasSMS := (Length(RealICQUser.Mobile) > 0);
- Employee.SMSHint := RealICQUser.Mobile;
- Employee.HasEmail := False;
- Employee.HasAddFriend := False;
- RealICQContacterTreeView.AddEmployee(Employee);
- Employee.Node.Selected := True;
- end;
- 2:
- begin //修改联系人
- ItemIndex := GetAddrBookUserIndex(ManageGroupMemberMsg.FGroupId, ManageGroupMemberMsg.FId);
- Employee := RealICQContacterTreeView.EmployeeItems.Objects[ItemIndex] as TRealICQEmployee;
- Employee.DisplayName := ManageGroupMemberMsg.FDisplayName;
- Employee.Mobile := ManageGroupMemberMsg.FMobile;
- Employee.SMSHint := ManageGroupMemberMsg.FMobile;
- Employee.HasSMS := (Length(ManageGroupMemberMsg.FMobile) > 0);
- Employee.Update;
- end;
- 3:
- begin //删除联系人
- ItemIndex := RealICQClient.AddrBookGroups.IndexOf(ManageGroupMemberMsg.FGroupId);
- RealICQBranch := RealICQClient.AddrBookGroups.Objects[ItemIndex] as TRealICQBranchInfo;
- RealICQBranch.EmployeeCount := RealICQBranch.EmployeeCount - 1;
- ItemIndex := GetAddrBookUserIndex(ManageGroupMemberMsg.FGroupId, ManageGroupMemberMsg.FId);
- if ItemIndex >= 0 then
- begin
- RealICQContacterTreeView.EmployeeItems.Delete(ItemIndex);
- RealICQUser := GetAddrBookUser(ManageGroupMemberMsg.FGroupId, ManageGroupMemberMsg.FId);
- RealICQClient.AddrBookUsers.Delete(RealICQClient.AddrBookUsers.IndexOfObject(RealICQUser));
- end;
- end;
- 4:
- begin //批量添加联系人
- TmpList := SplitString(ManageGroupMemberMsg.FId, ',');
- ItemIndex := RealICQClient.AddrBookGroups.IndexOf(ManageGroupMemberMsg.FGroupId);
- RealICQBranch := RealICQClient.AddrBookGroups.Objects[ItemIndex] as TRealICQBranchInfo;
- RealICQBranch.IsGetUserList := True;
- RealICQBranch.EmployeeCount := RealICQBranch.EmployeeCount + TmpList.Count;
- for iLoop := 0 to TmpList.Count - 1 do
- begin
- if GetAddrBookUser(ManageGroupMemberMsg.FGroupId, TmpList[iLoop]) = nil then
- begin
- ItemIndex := MainForm.RealICQClient.MoreUsers.IndexOf(TmpList[iLoop]);
- if ItemIndex >= 0 then
- RealICQUser := MainForm.RealICQClient.MoreUsers.Objects[ItemIndex] as TRealICQUser
- else
- begin
- RealICQUser := TUsersService.GetUsersService.GetOrRequestUser(TmpList[iLoop]);
- end;
- Employee := TRealICQEmployee.Create(RealICQUser.LoginName);
- Employee.BranchID := ManageGroupMemberMsg.FGroupId;
- Employee.DisplayName := RealICQUser.DisplayName;
- Employee.Mobile := RealICQUser.Mobile;
- Employee.HasSMS := (Length(RealICQUser.Mobile) > 0);
- Employee.EmailHint := RealICQUser.Email;
- Employee.SMSHint := RealICQUser.Mobile;
- Employee.HasEmail := False;
- Employee.HasAddFriend := False;
- RealICQContacterTreeView.AddEmployee(Employee);
- Employee.Node.Selected := True;
- end;
- end;
- for iLoop := TmpList.Count - 1 downto 0 do
- begin
- ItemIndex := MainForm.RealICQClient.MoreUsers.IndexOf(TmpList[iLoop]);
- if ItemIndex >= 0 then
- RealICQUser := MainForm.RealICQClient.MoreUsers.Objects[ItemIndex] as TRealICQUser
- else
- begin
- RealICQUser := TUsersService.GetUsersService.GetOrRequestUser(TmpList[iLoop]);
- end;
- TmpRealICQUser := MainForm.RealICQClient.MoreUsers.Objects[ItemIndex] as TRealICQUser;
- RealICQUser := TRealICQUser.Create(TmpList[iLoop], RealICQClient);
- RealICQUser.LoginName := TmpRealICQUser.LoginName;
- RealICQUser.DisplayName := TmpRealICQUser.DisplayName;
- RealICQUser.Mobile := TmpRealICQUser.Mobile;
- RealICQUser.BranchID := ManageGroupMemberMsg.FGroupId;
- RealICQUser.Tel := TmpRealICQUser.Tel;
- //RealICQUser.Email:=RealICQUser.EmailHint;
- MainForm.RealICQClient.AddrBookUsers.AddObject(RealICQUser.LoginName, RealICQUser);
- end;
- end;
- 5:
- begin
- TmpEmployee := FCutNode.Data;
- ItemIndex := RealICQClient.AddrBookGroups.IndexOf(ManageGroupMemberMsg.FGroupId);
- RealICQBranch := RealICQClient.AddrBookGroups.Objects[ItemIndex] as TRealICQBranchInfo;
- RealICQBranch.EmployeeCount := RealICQBranch.EmployeeCount + 1;
- ItemIndex := RealICQClient.AddrBookGroups.IndexOf(TmpEmployee.BranchID);
- RealICQBranch := RealICQClient.AddrBookGroups.Objects[ItemIndex] as TRealICQBranchInfo;
- RealICQBranch.EmployeeCount := RealICQBranch.EmployeeCount - 1;
- ItemIndex := GetAddrBookUserIndex(TmpEmployee.BranchID, TmpEmployee.LoginName);
- Employee := TRealICQEmployee.Create(TmpEmployee.LoginName);
- Employee.BranchID := ManageGroupMemberMsg.FGroupId;
- Employee.DisplayName := TmpEmployee.DisplayName;
- Employee.Tel := TmpEmployee.Tel;
- Employee.Mobile := TmpEmployee.Mobile;
- RealICQContacterTreeView.AddEmployee(Employee);
- RealICQUser := GetAddrBookUser(TmpEmployee.BranchID, TmpEmployee.LoginName);
- RealICQUser.BranchID := ManageGroupMemberMsg.FGroupId;
- RealICQContacterTreeView.EmployeeItems.Delete(ItemIndex);
- Employee.Node.Selected := True;
- end;
- 6:
- begin
- ItemIndex := GetAddrBookUserIndex(ManageGroupMemberMsg.FGroupId, ManageGroupMemberMsg.FId);
- Employee := RealICQContacterTreeView.EmployeeItems.Objects[ItemIndex] as TRealICQEmployee;
- if Employee <> nil then
- begin
- Employee.DisplayName := ManageGroupMemberMsg.FRemark;
- Employee.Update;
- end;
- end;
- end;
- FManageGroupMemberMsgList.Delete(i);
- end;
- finally
- if FCutNode <> nil then
- FCutNode := nil;
- end;
- end;
- //------得到联系人-----------------------------
- function TMainForm.GetAddrBookUser(GroupId, LoginName: string): TRealICQUser;
- var
- iLoop: Integer;
- RealICQUser: TRealICQUser;
- begin
- Result := nil;
- for iLoop := 0 to MainForm.RealICQClient.AddrBookUsers.Count - 1 do
- begin
- RealICQUser := MainForm.RealICQClient.AddrBookUsers.Objects[iLoop] as TRealICQUser;
- if (RealICQUser.BranchID = GroupId) and (RealICQUser.LoginName = LoginName) then
- begin
- Result := RealICQUser;
- Break;
- end;
- end;
- end;
- //------得到联系人的下标------------------------------
-
function TMainForm.GetAddrBookUserIndex(GroupId, LoginName: string): Integer;
- var
- iLoop: Integer;
- Employee: TRealICQEmployee;
- RealICQContacterTreeView: TRealICQContacterTreeView;
- begin
- Result := -1;
- RealICQContacterTreeView := MainForm.ContacterTreeViews.Objects[MainForm.ContacterTreeViews.IndexOf(LVAddrBook)] as TRealICQContacterTreeView;
- for iLoop := 0 to RealICQContacterTreeView.EmployeeItems.Count - 1 do
- begin
- Employee := RealICQContacterTreeView.EmployeeItems.Objects[iLoop] as TRealICQEmployee;
- if (Employee.BranchID = GroupId) and (Employee.LoginName = LoginName) then
- begin
- Result := iLoop;
- break;
- end;
- end;
- end;
- //-----得到联系人总的人数------------------
-
function TMainForm.GetGroupUserCount: Integer;
- var
- iLoop, ItemIndex: Integer;
- TmpBranch: TRealICQBranch;
- RealICQContacterTreeView: TRealICQContacterTreeView;
- begin
- ItemIndex := MainForm.ContacterTreeViews.IndexOf(LVAddrBook);
- if ItemIndex < 0 then
- Exit;
- RealICQContacterTreeView := MainForm.ContacterTreeViews.Objects[ItemIndex] as TRealICQContacterTreeView;
- for iLoop := 0 to RealICQContacterTreeView.BranchItems.Count - 1 do
- begin
- TmpBranch := RealICQContacterTreeView.BranchItems.Objects[iLoop] as TRealICQBranch;
- if TmpBranch.ParentID = '0' then
- begin
- Result := TmpBranch.EmployeeCount;
- break;
- end;
- end;
- end;
- //---------------------------显示联系人------------------------------
-
procedure TMainForm.GettedAddrBookUsers(Sender: TObject);
- var
- iLoop, ItemIndex: Integer;
- RealICQContacterTreeView: TRealICQContacterTreeView;
- RealICQUser: TRealICQUser;
- TmpBranch: TRealICQBranch;
- Employee: TRealICQEmployee;
- ParentNode: TTreeNode;
- BranchInfo: TRealICQBranchInfo;
- begin
- ItemIndex := MainForm.ContacterTreeViews.IndexOf(LVAddrBook);
- if ItemIndex < 0 then
- Exit;
- RealICQContacterTreeView := MainForm.ContacterTreeViews.Objects[ItemIndex] as TRealICQContacterTreeView;
- RealICQContacterTreeView.AdjustPosition := False;
- RealICQContacterTreeView.HideSystemScrollBar;
- RealICQContacterTreeView.BeginUpdate;
- TmpBranch := nil;
- ItemIndex := RealICQContacterTreeView.EmployeeItems.IndexOf('正在下载联系人');
- if ItemIndex >= 0 then
- begin
- Employee := RealICQContacterTreeView.EmployeeItems.Objects[ItemIndex] as TRealICQEmployee;
- TmpBranch := RealICQContacterTreeView.BranchItems.Objects[RealICQContacterTreeView.BranchItems.IndexOf(Employee.BranchID)] as TRealICQBranch;
- RealICQContacterTreeView.EmployeeItems.Delete(ItemIndex);
- BranchInfo := RealICQClient.AddrBookGroups.Objects[RealICQClient.AddrBookGroups.IndexOf(TmpBranch.BranchID)] as TRealICQBranchInfo;
- BranchInfo.IsGetUserList := True;
- end;
- {$region '添加联系人'}
- for iLoop := MainForm.RealICQClient.AddrBookUsers.Count - 1 downto 0 do
- begin
- RealICQUser := MainForm.RealICQClient.AddrBookUsers.Objects[iLoop] as TRealICQUser;
- if GetAddrBookUserIndex(RealICQUser.BranchID, RealICQUser.LoginName) >= 0 then
- Continue;
- if RealICQUser.BranchID <> TmpBranch.BranchID then
- Continue;
- Employee := TRealICQEmployee.Create(RealICQUser.LoginName);
- Employee.BranchID := RealICQUser.BranchID;
- Employee.Mobile := RealICQUser.Mobile;
- Employee.HasSMS := Length(RealICQUser.Mobile) > 0;
- Employee.SMSHint := RealICQUser.Mobile;
- Employee.HasEmail := False;
- if Trim(RealICQUser.Remark) <> '' then
- Employee.DisplayName := RealICQUser.Remark
- else
- Employee.DisplayName := RealICQUser.DisplayName;
- Employee.HasAddFriend := False;
- RealICQContacterTreeView.AddEmployee(Employee);
- end;
- {$endregion}
- if TmpBranch <> nil then
- begin
- ParentNode := TmpBranch.Node;
- while ParentNode <> nil do
- begin
- ParentNode.Expanded := True;
- ParentNode := ParentNode.Parent;
- end;
- TmpBranch.Node.Selected := True;
- TmpBranch.IsGetUserList := True;
- end;
- PostMessage(RealICQContacterTreeView.Handle, WM_SIZE, 0, 0);
- RealICQContacterTreeView.MoveScrollBarToTop;
- RealICQContacterTreeView.EndUpdate;
- end;
- //----------显示组-------------------------
- procedure TMainForm.GettedAddrBookGroups(Sender: TObject);
- begin
- LoadAddrBook('0');
- end;
- //-------------------------------------------------------------------------
-
procedure TMainForm.LoadAddrBook(ExpandGroupId: string);
- var
- iLoop, ItemIndex: Integer;
- RealICQContacterTreeView: TRealICQContacterTreeView;
- RealICQUser: TRealICQUser;
- BranchInfo: TRealICQBranchInfo;
- Branch, TmpBranch: TRealICQBranch;
- Employee: TRealICQEmployee;
- ParentNode: TTreeNode;
- BranchId: string;
- OnlineEmployee, EmployeeCount: Integer;
- begin
- ItemIndex := MainForm.ContacterTreeViews.IndexOf(LVAddrBook);
- if ItemIndex < 0 then
- Exit;
- RealICQContacterTreeView := MainForm.ContacterTreeViews.Objects[ItemIndex] as TRealICQContacterTreeView;
- RealICQContacterTreeView.OnItemOnline := nil;
- RealICQContacterTreeView.OnItemOffline := nil;
- RealICQContacterTreeView.OnItemIconButtonClick := nil;
- RealICQContacterTreeView.OnItemMouseEnter := nil;
- RealICQContacterTreeView.OnItemMouseLeave := nil;
- RealICQContacterTreeView.ShowOnlineNumber := False;
- RealICQContacterTreeView.ShowLoginState := False;
- RealICQContacterTreeView.PopupMenu := ppAddrbookList;
- RealICQContacterTreeView.AdjustPosition := False;
- RealICQContacterTreeView.HideSystemScrollBar;
- RealICQContacterTreeView.BeginUpdate;
- TmpBranch := nil;
- {$region '添加组'}
- for iLoop := 0 to MainForm.RealICQClient.AddrBookGroups.Count - 1 do
- begin
- BranchInfo := MainForm.RealICQClient.AddrBookGroups.Objects[iLoop] as TRealICQBranchInfo;
- if (RealICQContacterTreeView.BranchItems.IndexOf(BranchInfo.ID)) >= 0 then
- Continue;
- Branch := TRealICQBranch.Create(BranchInfo.BranchName);
- Branch.BranchID := BranchInfo.ID;
- Branch.ParentID := BranchInfo.ParentID;
- Branch.IsGetUserList := False;
- OnlineEmployee := 0;
- EmployeeCount := 0;
- GetBranchEmpOnlineAndSum(RealICQClient.AddrBookGroups, BranchInfo, OnlineEmployee, EmployeeCount);
- Branch.EmployeeCount := EmployeeCount;
- Branch.OnlineEmployee := 0;
- RealICQContacterTreeView.AddBranch(Branch);
- if ExpandGroupId = '0' then
- begin
- BranchId := Branch.ParentID;
- end
- else
- BranchId := Branch.BranchID;
- if BranchId = ExpandGroupId then
- begin
- TmpBranch := Branch;
- end;
- end;
- RealICQContacterTreeView.ReAlignBranchs;
- {$endregion}
- if TmpBranch <> nil then
- begin
- ParentNode := TmpBranch.Node;
- while ParentNode <> nil do
- begin
- ParentNode.Expanded := True;
- ParentNode := ParentNode.Parent;
- end;
- TmpBranch.Node.Selected := True;
- end;
- PostMessage(RealICQContacterTreeView.Handle, WM_SIZE, 0, 0);
- RealICQContacterTreeView.MoveScrollBarToTop;
- RealICQContacterTreeView.EndUpdate;
- ScrollBoxAddrBook.Visible := True;
- end;
- //----------------------------------------------
- procedure TMainForm.NodeGroupClick(Sender: TObject; Group: TRealICQBranch);
- var
- RealICQContacterTreeView: TRealICQContacterTreeView;
- ItemIndex: Integer;
- Employee: TRealICQEmployee;
- BranchInfo: TRealICQBranchInfo;
- begin
- //-------获取指定部门下的用户------------------------------------------------
- if (not Group.IsGetUserList) and (Group.Node.Parent <> nil) then
- begin
- MainForm.RealICQClient.OnGettedAddrBookUsers := GettedAddrBookUsers;
- ItemIndex := FContacterTreeViews.IndexOf(LVAddrBook);
- if ItemIndex < 0 then
- exit;
- RealICQContacterTreeView := FContacterTreeViews.Objects[ItemIndex] as TRealICQContacterTreeView;
- if RealICQContacterTreeView.EmployeeItems.IndexOf('正在下载联系人') < 0 then
- begin
- RealICQContacterTreeView.ReCalculateEmployeeCount(Group);
- BranchInfo := MainForm.RealICQClient.AddrBookGroups.Objects[MainForm.RealICQClient.AddrBookGroups.IndexOf(Group.BranchID)] as TRealICQBranchInfo;
- Employee := TRealICQEmployee.Create('正在下载联系人');
- Employee.BranchID := Group.BranchID;
- RealICQContacterTreeView.AddEmployee(Employee);
- if (BranchInfo.IsGetUserList) then
- begin
- GettedAddrBookUsers(nil);
- end
- else
- begin
- MainForm.RealICQClient.SendGetAddrbookUser(Group.BranchID);
- end;
- end;
- Group.Node.Expanded := True;
- end;
- end;
- //---------------------------------------------------------------------------
- function TMainForm.GetGroupUsers(GroupId: string): Integer;
- var
- iLoop: Integer;
- RealICQUser: TRealICQUser;
- begin
- Result := -1;
- for iLoop := 0 to MainForm.RealICQClient.AddrBookUsers.Count - 1 do
- begin
- RealICQUser := MainForm.RealICQClient.AddrBookUsers.Objects[iLoop] as TRealICQUser;
- if RealICQUser.BranchID = GroupId then
- begin
- Result := iLoop;
- end;
- end;
- end;
- {通讯录}
- procedure TMainForm.tsCustomerServiceContextPopup(Sender: TObject; MousePos: TPoint; var Handled: Boolean);
- begin
- end;
- //------------
- procedure TMainForm.tsNetWorkDiskShow(Sender: TObject);
- begin
- if RealICQClient.NetWorkDiskServerPort <= 0 then
- begin
- lblNDState.Caption := '没有服务器';
- end
- else
- begin
- if (not RealICQNetWorkDiskClient.Connected) and (not RealICQNetWorkDiskClient.Connectting) then
- begin
- spbNDConnectClick(spbNDConnect);
- end
- else if not AnsiSameText(RealICQNetWorkDiskClient.LoginName, RealICQClient.LoginName) then
- begin
- RealICQNetWorkDiskClient.Logout;
- spbNDConnectClick(spbNDConnect);
- end;
- end;
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.WebBrowserAddrBookBeforeNavigate2(ASender: TObject; const pDisp: IDispatch; var URL, Flags, TargetFrameName, PostData, Headers: OleVariant; var Cancel: WordBool);
- begin
- //
-
end;
- procedure TMainForm.WebBrowserAddrBookDocumentComplete(ASender: TObject; const pDisp: IDispatch; var URL: OleVariant);
- begin
- //
-
end;
- procedure TMainForm.WebBrowserForAdvertisementBeforeNavigate2(ASender: TObject; const pDisp: IDispatch; var URL, Flags, TargetFrameName, PostData, Headers: OleVariant; var Cancel: WordBool);
- begin
- if not AnsiSameText(URL, MainForm.RealICQClient.MainFormAdversement.URL) then
- begin
- ShellExecute(handle, 'open', PChar(GetDefaultBrowser), PChar('"' + string(URL) + '"'), '', SW_SHOWNORMAL);
- Cancel := True;
- end;
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.WebBrowserForAdvertisementDocumentComplete(ASender: TObject; const pDisp: IDispatch; var URL: OleVariant);
- begin
- try
- WebBrowserForAdvertisement.OnDocumentComplete := nil;
- WebBrowserForAdvertisement.OnBeforeNavigate2 := WebBrowserForAdvertisementBeforeNavigate2;
- SetDomStyle(WebBrowserForAdvertisement.Document as IHtmlDocument2);
- except
- end;
- pnlForHideWebBrowser.Visible := False;
- pnlAdvertisement.Top := pnlWebSearch.Top - 1;
- pnlAdvertisement.Height := RealICQClient.MainFormAdversement.Height + 2;
- pnlWebSearch.Top := pnlAdvertisement.Top + pnlAdvertisement.Height + 1;
- ClearMemory;
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.WebBrowserForContactersBeforeNavigate2(ASender: TObject; const pDisp: IDispatch; var URL, Flags, TargetFrameName, PostData, Headers: OleVariant; var Cancel: WordBool);
- var
- NewUrl: string;
- Args: string;
- ArgList: TStringList;
- AForm: TForm;
- index: Integer;
- begin
- NewUrl := URL;
- if AnsiSameText(Copy(NewUrl, 1, 18), 'OpenTalkingForm://') then
- begin
- Cancel := True;
- Args := Copy(NewUrl, 19, Length(NewUrl) - 19);
- if AnsiSameText(Args, RealICQClient.Me.LoginName) then
- begin
- MessageBox(Handle, '对不起，不可以和自己对话！', '提示', MB_ICONINFORMATION);
- Exit;
- end;
- OpenTalkingForm(Args, True);
- Exit;
- end;
- if AnsiSameText(Copy(NewUrl, 1, 12), 'AddFriend://') then
- begin
- Cancel := True;
- Args := Copy(NewUrl, 13, Length(NewUrl) - 13);
- if AnsiSameText(Args, RealICQClient.Me.LoginName) then
- begin
- MessageBox(Handle, '对不起，不可以加自己为好友！', '提示', MB_ICONINFORMATION);
- Exit;
- end;
- if TUsersService.GetUsersService.IsWorkmateOrFriend(Args) then
- begin
- MessageBox(Handle, PChar('用户 ' + Args + ' 已在您的好友列表中！'), '提示', MB_ICONINFORMATION);
- Exit;
- end;
- ShowAddFriendWindow(Self, Args, '');
- Exit;
- end;
- end;
- //------------------------------------------------------------------------------
-
procedure TMainForm.ppLanguagesGetControlClass(Sender: TCustomActionBar; AnItem: TActionClient; var ControlClass: TCustomActionControlClass);
- begin
- ChangePPMenuColorMap(ppLanguages.PopupMenu);
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.miLanguageClick(Sender: TObject);
- var
- MenuItem: TMenuItem;
- begin
- MenuItem := Sender as TMenuItem;
- ChangeLanguage(ExtractFilePath(Application.ExeName) + 'Languages\' + AnsiReplaceStr(MenuItem.Caption, '&', '') + '.ini');
- end;
- procedure TMainForm.miLeaveClick(Sender: TObject);
- begin
- FLoginState := stLeave;
- FLeaveMessage := '离开';
- SetLoginStateControlState;
- end;
- procedure TMainForm.ppLanguagesPopup(Sender: TObject);
- var
- MenuItem: TMenuItem;
- procedure FindLanguages(APath: string);
- var
- DSearchRec: TSearchRec;
- FindResult: Integer;
- begin
- ppLanguages.Items.Clear;
- FindResult := FindFirst(APath + '*.ini', faAnyFile, DSearchRec);
- while FindResult = 0 do
- begin
- if (DSearchRec.Name <> '.') and (DSearchRec.Name <> '..') then
- if (DSearchRec.Attr and faDirectory) <> faDirectory then
- begin
- MenuItem := TMenuItem.Create(ppLanguages);
- MenuItem.AutoHotkeys := maManual;
- MenuItem.AutoLineReduction := maManual;
- MenuItem.Caption := AnsiReplaceText(DSearchRec.Name, '.ini', '') + '&';
- MenuItem.OnClick := miLanguageClick;
- MenuItem.RadioItem := True;
- MenuItem.AutoCheck := True;
- MenuItem.Enabled := Language <> AnsiReplaceText(DSearchRec.Name, '.ini', '');
- MenuItem.Checked := Language = AnsiReplaceText(DSearchRec.Name, '.ini', '');
- ppLanguages.Items.Insert(0, MenuItem);
- end;
- FindResult := FindNext(DSearchRec);
- end;
- end;
- begin
- FindLanguages(ExtractFilePath(Application.ExeName) + 'Languages\');
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.Post(stURL, stPostData: string; var wbWebBrowser: TWebBrowser);
- var
- vWebAddr, vPostData, vFlags, vFrame, vHeaders: OleVariant;
- iLoop: Integer;
- begin
- {Are we posting data to this Url?}
- if Length(stPostData) > 0 then
- begin
- {头信息当PostData使.}
- vHeaders := 'Content-Type: application/x-www-form-urlencoded' + #10#13#0;
- vPostData := VarArrayCreate([0, Length(stPostData)], varByte);
- for iLoop := 0 to Length(stPostData) - 1 do
- begin
- vPostData[iLoop] := Ord(stPostData[iLoop + 1]);
- end;
- {结束字符}
- vPostData[Length(stPostData)] := 0;
- {Set the type of Variant, cast}
- TVarData(vPostData).vType := varArray;
- end;
- vWebAddr := stURL;
- wbWebBrowser.Navigate2(vWebAddr, vFlags, vFrame, vPostData, vHeaders);
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.ChangeLanguage(ALanguageIniFile: string);
- var
- IniFile: TIniFile;
- iLoop: Integer;
- OldLVAddrbook, OldLVSystemMessage, OldLVMyContacters, OldLVMoreUsers, OldLVFriends, OldLVStrangers, OldLVBlacklists, OldLVLatests, OldLVTeams, OldLVSearch: string;
- begin
- inherited ChangeLanguage(ALanguageIniFile);
- RealICQClient.ChangeLanguage(ALanguageIniFile);
- IniFile := TIniFile.Create(ExtractFilePath(Application.ExeName) + 'Languages\' + Language + '.ini');
- try
- {$region}
- with IniFile do
- begin
- OldLVSystemMessage := LVSystemMessage;
- OldLVMyContacters := LVMyContacters;
- OldLVFriends := LVFriends;
- OldLVStrangers := LVStrangers;
- OldLVBlacklists := LVBlacklists;
- OldLVLatests := LVLatests;
- OldLVTeams := LVTeams;
- OldLVSearch := LVSearch;
- OldLVMoreUsers := LVMoreUsers;
- OldLVAddrbook := LvAddrbook;
- LVSystemMessage := FilterStr(ReadString(string(Self.ClassName), 'LVSystemMessage', ''));
- LVMyContacters := FilterStr(ReadString(string(Self.ClassName), 'LVMyContacters', ''));
- LVMoreUsers := FilterStr(ReadString(string(Self.ClassName), 'LVMoreUser', ''));
- LVFriends := FilterStr(ReadString(string(Self.ClassName), 'LVFriends', ''));
- LVStrangers := FilterStr(ReadString(string(Self.ClassName), 'LVStrangers', ''));
- LVBlacklists := FilterStr(ReadString(string(Self.ClassName), 'LVBlacklists', ''));
- LVLatests := FilterStr(ReadString(string(Self.ClassName), 'LVLatests', ''));
- LVTeams := FilterStr(ReadString(string(Self.ClassName), 'LVTeams', ''));
- LVSearch := FilterStr(ReadString(string(Self.ClassName), 'LVSearch', ''));
- LVAddrbook := FilterStr(ReadString(string(Self.ClassName), 'LVAddrbook', ''));
- end;
- {$endregion}
- finally
- FreeAndNil(IniFile);
- end;
- edWebSearchKeyWordExit(nil);
- for iLoop := 0 to FContacterListViews.Count - 1 do
- begin
- if AnsiSameStr(OldLVSystemMessage, FContacterListViews.Strings[iLoop]) then
- FContacterListViews.Strings[iLoop] := LVSystemMessage;
- if AnsiSameStr(OldLVMyContacters, FContacterListViews.Strings[iLoop]) then
- FContacterListViews.Strings[iLoop] := LVMyContacters;
- if AnsiSameStr(OldLVFriends, FContacterListViews.Strings[iLoop]) then
- FContacterListViews.Strings[iLoop] := LVFriends;
- if AnsiSameStr(OldLVStrangers, FContacterListViews.Strings[iLoop]) then
- FContacterListViews.Strings[iLoop] := LVStrangers;
- if AnsiSameStr(OldLVAddrbook, FContacterListViews.Strings[iLoop]) then
- FContacterListViews.Strings[iLoop] := LVAddrbook;
- //if AnsiSameStr(OldLVBlacklists, FContacterListViews.Strings[iLoop]) then
- // FContacterListViews.Strings[iLoop] := LVBlacklists;
- if AnsiSameStr(OldLVLatests, FContacterListViews.Strings[iLoop]) then
- FContacterListViews.Strings[iLoop] := LVLatests;
- if AnsiSameStr(OldLVTeams, FContacterListViews.Strings[iLoop]) then
- FContacterListViews.Strings[iLoop] := LVTeams;
- if AnsiSameStr(OldLVSearch, FContacterListViews.Strings[iLoop]) then
- FContacterListViews.Strings[iLoop] := LVSearch;
- end;
- for iLoop := 0 to FContacterTreeViews.Count - 1 do
- begin
- if AnsiSameStr(OldLVMyContacters, FContacterTreeViews.Strings[iLoop]) then
- FContacterTreeViews.Strings[iLoop] := LVMyContacters;
- if AnsiSameStr(OldLVFriends, FContacterTreeViews.Strings[iLoop]) then
- FContacterTreeViews.Strings[iLoop] := LVFriends;
- if AnsiSameStr(OldLVMoreUsers, FContacterTreeViews.Strings[iLoop]) then
- FContacterTreeViews.Strings[iLoop] := LVMoreUsers;
- if AnsiSameStr(OldLVAddrbook, FContacterTreeViews.Strings[iLoop]) then
- FContacterTreeViews.Strings[iLoop] := LVAddrbook;
- end;
- if (RealICQClient.Logined and RealICQClient.Connected and pnlWorkArea.Visible) then
- begin
- ShowGroupInterface;
- end;
- edFilterKeyword.Text := '';
- edFilterKeywordExit(edFilterKeyword);
- SetUIState;
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.SetLoginControlsVisible(Value: Boolean);
- begin
- lblLoginNameTitle.Visible := Value;
- spLoginNameBorder.Visible := Value;
- spbChangeLoginName.Visible := Value;
- edLoginName.Visible := Value;
- lblPasswordTitle.Visible := Value;
- spPasswordBorder.Visible := Value;
- edPassword.Visible := Value;
- lblLoginStateTitle.Visible := Value;
- spbLoginState.Visible := Value;
- spbSavePassword.Visible := Value;
- spbAutoLogin.Visible := Value;
- //btnCALogin.Visible := RealICQClient.CaEnable and Value;
- btLogin.Visible := Value;
- lblRemoveMyLoginInfo.Visible := Value and RealICQClient.SavedPassword;
- lblPasswordTitle.Enabled := not lblRemoveMyLoginInfo.Visible;
- edPassword.Enabled := not lblRemoveMyLoginInfo.Visible;
- //lblForgotPassword.Visible := Value;
- lblNetworkConfig.Visible := Value;
- //lblHelper.Visible := Value;
- //lblNetworkConfig.Top:=Height-100;
- //lblHelper.Top:=Height-80;
- //lblRegister.Visible := Value;
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.RealICQClientDisconnected(Sender: TObject);
- begin
- ScrollBoxMoreUser.Tag := 0;
- try
- if FSearchListViewInVisible then
- spbCancelFilterClick(nil);
- //ToDo
- if pnlMiddleRight.Visible then
- ShowOrHideMuiltiWeb;
- if Assigned(AGuideViewForm) then
- FreeAndNil(AGuideViewForm);
- finally
- lblLoginState.Caption := '正在注销...';
- SetLoginControlsVisible(False);
- pnlWorkArea.Visible := False;
- pnlLogout.Visible := True;
-
- //WebBrowserForEMail.Navigate('http://mail.lishui.gov.cn/web_email/modules/i_logout.phtml');
- TimerForCheckLogoutTimeout.Enabled := True;
- TimerForGetBranchOnlineStates.Enabled := False;
- pnlForTopMessage.Visible := False;
- TimerForShowSystemNotices.Enabled := pnlForTopMessage.Visible;
- { TODO -olqq -c : 退出时，重置Log的登录名 2014/12/14 10:59:28 }
- LoggerImport.LoginName := '';
- TTeamsAdapter.Stop;
- TMessagesHander.GetHander.Uninstall;
- TMainFormController.GetController.LogoutFromAppCentre;
- FDBHistory.DBFileName := '';
- end;
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.SetUIState;
- var
- iLoop: Integer;
- RealICQContacterListView: TRealICQContacterListView;
- RealICQContacterTreeView: TRealICQContacterTreeView;
- RealICQFriendTreeView: TRealICQContacterTreeView;
- GroupMembers: TStringList;
- TabSheet: TTabSheet;
- SystemMessage: TRealICQSystemMessage;
- NotReadMessageObject: TObject;
- MessageList: TList;
- Employee: TRealICQEmployee;
- RealICQUser: TRealICQUser;
- VisibleValue: Boolean;
- iIndex: Integer;
- GroupName, MessageID: string;
- SysMsgInterface: TSysMsgInterface;
- begin
- if OptionsForm <> nil then
- OptionsForm.GetSets;
- {$region '根据状态显示登录界面上的按钮等界面元素的内容和行为'}
- TimerForLogining.Enabled := RealICQClient.Logining;
- if True then
- edLoginName.Text := RealICQClient.InputLoginName;
- if RealICQClient.Logining then
- begin
- actLoginAs.Enabled := False;
- lblLoginState.Caption := '正在登录...';
- lblLoginState.Refresh;
- SetLoginControlsVisible(False);
- btLogin.Enabled := True;
- btLogin.Visible := True;
- btLogin.Caption := '取消(&C)';
- btLogin.Refresh;
- Application.ProcessMessages;
- end
- else if RealICQClient.SavedPassword and (not RealICQClient.Logined) then
- begin
- edPassword.Text := '保存的密码';
- lblPasswordTitle.Enabled := False;
- edPassword.Enabled := False;
- FLoginAsSavePassword := True;
- actLoginAs.Enabled := (not RealICQClient.Logined or not RealICQClient.Connected) and (not RealICQClient.Logining);
- actLoginAs.Caption := '作为 ' + RealICQClient.LoginName + ' 登录(&S)';
- btLogin.Enabled := True;
- btLogin.Visible := True;
- btLogin.Caption := '登录(&S)';
- btLogin.Refresh;
- lblLoginState.Caption := '';
- SetLoginControlsVisible(True);
- end
- else if (not RealICQClient.Logined) then
- begin
- edPassword.Text := '';
- lblPasswordTitle.Enabled := True;
- edPassword.Enabled := True;
- FLoginAsSavePassword := False;
- actLoginAs.Enabled := False;
- actLoginAs.Caption := '作为 ... 登录(&S)';
- btLogin.Enabled := True;
- btLogin.Visible := True;
- btLogin.Caption := '登录(&S)';
- btLogin.Refresh;
- lblLoginState.Caption := '';
- SetLoginControlsVisible(True);
- end;
- {$endregion}
- {$region '设置控件的Enabled属性'}
- actReg.Enabled := (not RealICQClient.Logining) and (not RealICQClient.Reging);
- actOptions.Enabled := (not RealICQClient.Logining) and (not RealICQClient.Reging);
- actConnectSet.Enabled := actOptions.Enabled;
- actLogout.Enabled := (not (not RealICQClient.Logined or not RealICQClient.Connected) and (not RealICQClient.Logining) and (not RealICQClient.Reging)) and RealICQClient.Connected;
- actOpenRecvFileDir.Enabled := actLogout.Enabled;
- btLogin.Default := not actLogout.Enabled;
- actOnline.Enabled := actLogout.Enabled;
- actHidden.Enabled := actLogout.Enabled;
- actOffline.Enabled := actLogout.Enabled;
- actBusy.Enabled := actLogout.Enabled;
- actMute.Enabled := actLogout.Enabled;
- actLeave.Enabled := actLogout.Enabled;
- actPhone.Enabled := actLogout.Enabled;
- actRepast.Enabled := actLogout.Enabled;
- actMeeting.Enabled := actLogout.Enabled;
- actOtherState.Enabled := actLogout.Enabled;
- actOfflieAutoResponse.Enabled := actLogout.Enabled;
- actPersonalSet.Enabled := actLogout.Enabled;
- actChangePass.Enabled := actLogout.Enabled;
- actFindUsers.Enabled := actLogout.Enabled;
- actShowLoginName.Enabled := actLogout.Enabled;
- actShowDisplayName.Enabled := actLogout.Enabled;
- actShowAllName.Enabled := actLogout.Enabled;
- actShowRemark.Enabled := actLogout.Enabled;
- actShowBigHeadImage.Enabled := actLogout.Enabled;
- actShowMiddleHeadImage.Enabled := actLogout.Enabled;
- actShowSmallHeadImage.Enabled := actLogout.Enabled;
- actShowNormalHeadImage.Enabled := actLogout.Enabled;
- actShowGroup.Enabled := actLogout.Enabled;
- actGroupManager.Enabled := actLogout.Enabled;
- actShowStrangers.Enabled := actLogout.Enabled;
- actShowBlacklists.Enabled := actLogout.Enabled;
- actShowTeams.Enabled := actLogout.Enabled;
- actShowLatests.Enabled := actLogout.Enabled;
- actShowGIFInMailForm.Enabled := actLogout.Enabled;
- actShowGIFInTalkingForm.Enabled := actLogout.Enabled;
- actCustomFacesManager.Enabled := actLogout.Enabled;
- actMsgManager.Enabled := actLogout.Enabled;
- actAVSet.Enabled := actLogout.Enabled;
- RealICQNetWorkDiskClientConnectStateChanged(Self.RealICQNetWorkDiskClient);
- SetLoginStateMenuChecked;
- SetStyleMenuChecked;
- {$endregion}
- {$region '设置控件的Visible属性'}
- lblReConnect.Visible := False;
- actLoginAs.Visible := actLoginAs.Enabled;
- if (RealICQClient.WorkingMode = wmCorporation) then
- begin
- actShowBigHeadImage.Visible := False;
- actShowMiddleHeadImage.Visible := False;
- actShowStrangers.Visible := False;
- actShowBlacklists.Visible := False;
- actReg.Visible := False;
- //actFindUsers.Visible := False;
-
actShowTree.Visible := False;
- end
- else
- begin
- actShowBigHeadImage.Visible := not actShowTree.Checked;
- actShowMiddleHeadImage.Visible := not actShowTree.Checked;
- actShowStrangers.Visible := True;
- actShowBlacklists.Visible := True;
- actReg.Visible := True;
- //actFindUsers.Visible := True;
-
actShowTree.Visible := True;
- end;
- VisibleValue := RealICQClient.Logined and RealICQClient.Connected;
- ActionManager.ActionBars.ActionBars[1].Items[1].Visible := VisibleValue;
- ActionManager.ActionBars.ActionBars[1].Items[2].Visible := VisibleValue;
- //spbShowHideRight.Visible := VisibleValue;
- {$endregion}
- {$region '根据登录/连接状态，显示登录界面或联系人界面'}
-
if RealICQClient.Logined and RealICQClient.Connected then
- begin
- pnlWorkArea.Visible := True;
- pnlLogout.Visible := False;
- SetAllTakingFormEnabledState(True);
- SetAllSMSFormEnabledState(True);
- if not TLimitCondition.UserInfoCheck(MainForm.RealICQClient.Me) then
- begin
- MainForm.actPersonalSetExecute(nil)
- end
- else if TLimitCondition.FirstLoginComfirm then
- begin
- ShowMessage('请确认或修改您的个人信息！');
- MainForm.actPersonalSetExecute(nil);
- end;
- end
- else
- begin
- pnlWorkArea.Visible := False;
- pnlLogout.Visible := True;
- tsCustomerService.PageControl := nil;
- tsCustomers.PageControl := pgcMainWorkArea;
- RealICQNetWorkDiskClient.Logout;
- if VideoForm <> nil then
- FreeAndNil(VideoForm);
- if CreateTeamForm <> nil then
- FreeAndNil(CreateTeamForm);
- if SearchForm <> nil then
- FreeAndNil(SearchForm);
- if VCardForm <> nil then
- FreeAndNil(VCardForm);
- if SearchTeamForm <> nil then
- FreeAndNil(SearchTeamForm);
- if SelFaceForm <> nil then
- FreeAndNil(SelFaceForm);
- if CustomFacesManagerForm <> nil then
- FreeAndNil(CustomFacesManagerForm);
- if MessagesManagerForm <> nil then
- FreeAndNil(MessagesManagerForm);
- if AddFaceForm <> nil then
- FreeAndNil(AddFaceForm);
- try
- CloseAllTeamOptionsForms;
- except
- end;
- try
- WebBrowserForAdvertisement.OnDocumentComplete := nil;
- WebBrowserForAdvertisement.OnBeforeNavigate2 := nil;
- pnlAdvertisement.Height := 0;
- if WebBrowserForAdvertisement.Busy then
- WebBrowserForAdvertisement.Stop;
- WebBrowserForAdvertisement.Navigate('about:blank');
- except
- end;
- try
- // CloseAllSeeUserInformationForms;
-
except
- end;
- try
- CloseAllChangeSystemMessageForms;
- except
- end;
- try
- SetAllTakingFormEnabledState(False);
- SetAllSMSFormEnabledState(False);
- except
- end;
- TimerForFlashTrayIcon.Enabled := False;
- if Assigned(NotReadMessageBoxForm) then
- NotReadMessageBoxForm.Visible := False;
- TrayIcon.Icon.LoadFromFile(ExtractFilePath(Application.ExeName) + 'Images\State\TrayIcon\Offline.ico');
- TrayIcon.SetDefaultIcon;
- TrayIcon.Hint := Application.Title + ' - 未登录';
- {$region '删除WEB标签'}
- try
- for iLoop := 0 to FWebTabs.Count - 1 do
- begin
- TabSheet := FWebTabs[iLoop];
- TabSheet.PageControl := nil;
- FreeAndNil(TabSheet);
- end;
- except
- end;
- FWebTabs.Clear;
- {$endregion}
- {$region '删除未处理的系统消息'}
-
try
- for iLoop := 0 to FSystemMessages.Count - 1 do
- begin
- SystemMessage := FSystemMessages[iLoop];
- FreeAndNil(SystemMessage);
- end;
- except
- end;
- FSystemMessages.Clear;
- {$endregion}
-
- {$region '清除还未读的消息'}
-
for iLoop := 0 to FNotReadMessages.Count - 1 do
- begin
- MessageID := FNotReadMessages[iLoop];
- if AnsiSameStr(Copy(MessageID, 1, Length(SystemMessageID)), SystemMessageID) then
- begin
- try
- NotReadMessageObject := FNotReadMessages.Objects[iLoop];
- FreeAndNil(NotReadMessageObject);
- except
- end;
- end
- else
- begin
- MessageList := FNotReadMessages.Objects[iLoop] as TList;
- while MessageList.Count > 0 do
- begin
- try
- NotReadMessageObject := TObject(MessageList[0]);
- FreeAndNil(NotReadMessageObject);
- except
- end;
- MessageList.Delete(0);
- end;
- FreeAndNil(MessageList);
- end;
- end;
- FNotReadMessages.Clear;
- {$endregion}
- {try
- for iLoop :=FNotAddedEmployeeList.Count-1 Downto 0 do
- begin
- try
- RealICQUser:= FNotAddedEmployeeList.Objects[iLoop] as TRealICQUser;
- if Assigned(RealICQUser) then FreeAndNil(RealICQUser);
- except
- end;
- end;
- finally
- FNotAddedEmployeeList.Clear;
- end; }
- if FNotAddedEmployeeList.Count > 0 then
- FNotAddedEmployeeList.Clear;
- if Assigned(FLVSystemMessage) then
- FLVSystemMessage.Items.Clear;
- if Assigned(FLVTeams) then
- FLVTeams.Items.Clear;
- if Assigned(FLVCustomers) then
- FLVCustomers.Items.Clear;
- {$region '删除用于显示用户列表对象'}
- for iLoop := FContacterListViews.Count - 1 downto 0 do
- begin
- RealICQContacterListView := FContacterListViews.Objects[iLoop] as TRealICQContacterListView;
- try
- RealICQContacterListView.Items.Clear;
- except
- end;
- GroupName := FContacterListViews[iLoop];
- if AnsiSameText(GroupName, LVFriends) or AnsiSameText(GroupName, LVStrangers) or
- {AnsiSameText(GroupName, LVBlacklists) or}
- (FGroups.IndexOf(GroupName) >= 0) then
- begin
- try
- FreeAndNil(RealICQContacterListView);
- except
- end;
- FContacterListViews.Delete(iLoop);
- end;
- end;
- for iLoop := FContacterTreeViews.Count - 1 downto 0 do
- begin
- try
- RealICQContacterTreeView := FContacterTreeViews.Objects[iLoop] as TRealICQContacterTreeView;
- try
- RealICQContacterTreeView.Clear;
- except
- end;
- finally
- try
- FreeAndNil(RealICQContacterTreeView);
- except
- end;
- FContacterTreeViews.Delete(iLoop);
- end;
- end;
- for iLoop := FContacterTreeViews.Count - 1 downto 0 do
- begin
- try
- RealICQFriendTreeView := FContacterTreeViews.Objects[iLoop] as TRealICQContacterTreeView;
- try
- RealICQFriendTreeView.Clear;
- except
- end;
- finally
- try
- FreeAndNil(RealICQFriendTreeView);
- except
- end;
- FContacterTreeViews.Delete(iLoop);
- end;
- end;
-
- {$endregion}
- for iLoop := 0 to RealICQClient.SysMsgInterfaces.Count - 1 do
- begin
- SysMsgInterface := RealICQClient.SysMsgInterfaces.Objects[iLoop] as TSysMsgInterface;
- FreeAndNil(SysMsgInterface);
- end;
- RealICQClient.SysMsgInterfaces.Clear;
- for iLoop := 0 to FGroups.Count - 1 do
- begin
- GroupMembers := FGroups.Objects[iLoop] as TStringList;
- GroupMembers.Clear;
- GroupMembers.Free;
- end;
- FGroups.Clear;
- end;
- {$endregion}
- PostMessage(Handle, WM_SIZE, 0, 0);
- Application.ProcessMessages;
- if not TrayIcon.Visible then
- begin
- TrayIcon.Visible := True;
- end;
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.AddMessageHistory(ASystemMessageType: TSystemMessageType; ASimpleMessage: string; ASystemMessage: TRealICQSystemMessage);
- var
- ItemIndex: Integer;
- ListItem: TRealICQContacterListItem;
- ID: string;
- begin
- ID := '';
- case ASystemMessageType of
- smSimple:
- begin
- ID := IntToStr(GetTickCount);
- while FLVSystemMessage.Items.IndexOf(ID) >= 0 do
- begin
- ID := IntToStr(GetTickCount);
- Sleep(10);
- Application.ProcessMessages;
- end;
- end;
- smSystemMessage:
- ID := IntToStr(ASystemMessage.MessageID);
- end;
- FLVSystemMessage.ShowHeadImageButton := False;
- ItemIndex := FLVSystemMessage.Items.Add(ID);
- ListItem := FLVSystemMessage.Items.Objects[ItemIndex] as TRealICQContacterListItem;
- with ListItem do
- begin
- DisplayName := TimeToStr(Now);
- LoginState := stOnline;
- case ASystemMessageType of
- smSimple:
- begin
- Watchword := ASimpleMessage;
- try
- HeadImagePicture.LoadFromFile(ExtractFilePath(Application.ExeName) + SimpleMessagePicture);
- except
- end;
- end;
- smSystemMessage:
- begin
- Watchword := ASystemMessage.Title;
- try
- HeadImagePicture.LoadFromFile(ExtractFilePath(Application.ExeName) + SystemMessagePicture);
- except
- end;
- end;
- end;
- ReDrawItem;
- end;
- FLVSystemMessage.TopIndex := ItemIndex;
- end;
- //------------------------------------------------------------------------------
- constructor TMainForm.Create(AOwner: TComponent);
- begin
- MainForm := Self;
- inherited Create(AOwner);
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.FormCreate(Sender: TObject);
- function URLDecode(const S: string): string;
- var
- Idx: Integer; // loops thru chars in string
- Hex: string; // string of hex characters
- Code: Integer; // hex character code (-1 on error)
- begin
- // Intialise result and string index
- Result := '';
- Idx := 1;
- // Loop thru string decoding each character
- while Idx <= Length(S) do
- begin
- case S[Idx] of
- '%':
- begin
- // % should be followed by two hex digits - exception otherwise
- if Idx <= Length(S) - 2 then
- begin
- // there are sufficient digits - try to decode hex digits
- Hex := S[Idx + 1] + S[Idx + 2];
- Code := SysUtils.StrToIntDef('$' + Hex, -1);
- Inc(Idx, 2);
- end
- else
- // insufficient digits - error
- Code := -1;
- // check for error and raise exception if found
- if Code = -1 then
- raise SysUtils.EConvertError.Create('Invalid hex digit in URL');
- // decoded OK - add character to result
- Result := Result + Chr(Code);
- end;
- '+':
- // + is decoded as a space
- Result := Result + ' ' else
- // All other characters pass thru unchanged
- Result := Result + S[Idx];
- end;
- Inc(Idx);
- end;
- end;
- function UserIsLogined(user: string): Boolean;
- var
- hWndStart, hwndLike: HWND;
- WndCaption: array[0..254] of char;
- WndClassName: array[0..254] of char;
- ActiveTimes: Integer;
- begin
- Result := False;
- try
- ActiveTimes := 0;
- hWndStart := GetDesktopWindow;
- hwndLike := GetWindow(hWndStart, GW_CHILD);
- while hwndLike <> 0 do
- begin
- GetWindowText(hwndLike, @WndCaption, 254);
- GetClassName(hwndLike, @WndClassName, 254);
- if (pos(user, StrPas(WndCaption)) <> 0) and (pos('TrueHiddenMainForm', StrPas(WndClassName)) <> 0) then
- begin
- Result := True;
- ShowWindow(hwndLike, SW_SHOW);
- ForceForeGroundWindow(hwndLike);
- Inc(ActiveTimes);
- if ActiveTimes >= 2 then
- Break;
- end;
- hwndLike := GetWindow(hwndLike, GW_HWNDNEXT);
- end;
- except
- on E: Exception do
- begin
- Error(E.Message, 'TMainForm.UserIsLogined(' + user + ')');
- end;
- end;
- end;
- var
- iIndex, i: Integer;
- gif: TGIFImage;
- ca: string;
- IdHttp: TIdHTTP;
- ResponeStr: string;
- Sends: TStrings;
- jo, ja: ISuperObject;
- CALoginName, CAPassWord: string;
- icon: TIcon; //cmg
- begin
- try
- FServerInfoList := TStringList.Create;
- TAuthority.SetDropFileAuthority;
- TrayIcon.Visible := False;
- if FileExists(ExtractFilePath(paramstr(0)) + LoginingGif) then
- begin
- gif := TGIFImage.Create;
- try
- gif.LoadFromFile(ExtractFilePath(paramstr(0)) + LoginingGif);
- gif.Animate := True;
- ImgLoadingMoreBranchs.Picture.Assign(gif);
- finally
- gif.Free;
- end;
- end;
- //ImgLstForLogining.FileLoad(rtIcon, ExtractFilePath(paramstr(0)) + 'Images\State\TrayIcon\0.ico', $ff00ff);
- //ImgLstForLogining.FileLoad(rtIcon, ExtractFilePath(paramstr(0)) + 'Images\State\TrayIcon\1.ico', $ff00ff);
- //ImgLstForLogining.FileLoad(rtIcon, ExtractFilePath(paramstr(0)) + 'Images\State\TrayIcon\2.ico', $ff00ff);
- //ImgLstForLogining.FileLoad(rtIcon, ExtractFilePath(paramstr(0)) + 'Images\State\TrayIcon\3.ico', $ff00ff);
- //cmg
- begin
- Icon := Ticon.create;
- try
- Icon.LoadFromFile(ExtractFilePath(Application.ExeName) + 'Images\State\TrayIcon\0.ico');
- i := ImgLstForLogining.addicon(Icon);
- Icon.LoadFromFile(ExtractFilePath(Application.ExeName) + 'Images\State\TrayIcon\1.ico');
- i := ImgLstForLogining.addicon(Icon);
- Icon.LoadFromFile(ExtractFilePath(Application.ExeName) + 'Images\State\TrayIcon\2.ico');
- i := ImgLstForLogining.addicon(Icon);
- Icon.LoadFromFile(ExtractFilePath(Application.ExeName) + 'Images\State\TrayIcon\3.ico');
- i := ImgLstForLogining.addicon(Icon);
- finally
- Icon.Free;
- end;
- end;
- //注册自定义消息
- CLOSEWINDOWS := RegisterWindowMessage('关闭窗口');
- if FileExists(ExtractFilePath(Application.ExeName) + 'Images\Logo.gif') then
- ImgLogo.Picture.LoadFromFile(ExtractFilePath(Application.ExeName) + 'Images\Logo.gif');
- if FileExists(ExtractFilePath(Application.ExeName) + 'Images\AppCode.png') then
- ImgApp.Picture.LoadFromFile(ExtractFilePath(Application.ExeName) + 'Images\AppCode.png');
- LoadMainTabImage;
- //LoadGroupConfig;(群组配置信息转移到CEF)
- //FDownFile := TDownFile.Create;
- //FDownFile.OnComplete := DownFileComplete;
- //调用自动更新程序
-
FCheckedUpdate := True;
- try
- RegisterOleFile(ExtractFilePath(Application.ExeName) + IEContext_DLL_PACH, 1);
- except
- on E: Exception do
- Error(E.Message, 'TMainForm.FormCreate-RegisterOleFile(IEContext.dll)');
- end;
- try
- RegisterOleFile(ExtractFilePath(Application.ExeName) + ImageX2_DLL_PACH, 1);
- except
- on E: Exception do
- Error(E.Message, 'TMainForm.FormCreate-RegisterOleFile(ImageX2.dll)');
- end;
- try
- RegisterOleFile(ExtractFilePath(Application.ExeName) + AppCentreCom_DLL_PACH, 1);
- except
- on E: Exception do
- Error(E.Message, 'TMainForm.FormCreate-RegisterOleFile(AppCentreCom.dll)');
- end;
- if HookID <> 0 then
- UnHookWindowsHookEx(HookID);
- HookID := SetWindowsHookEx(WH_MOUSE, MouseProc, 0, GetCurrentThreadId());
- MinButtonForClose := True;
- FGettedTrayIconRect := False;
- FMainFormHidden := False;
- FWindowMoveing := False;
- FHidePosition := hpNone;
- SetWindowLong(Handle, GWL_EXSTYLE, GetWindowLong(Handle, GWL_EXSTYLE) or WS_EX_TOOLWINDOW);
- Caption := Application.Title;
- actOpenMainForm.Caption := '打开 ' + Application.Title + ' 主界面(&O)';
- //btShowMiniPage.Visible := TCustomerConfig.GetConfig.ShowGuideViewBtn;
- FIsLogout := False;
- DoubleBuffered := True;
- pnlTop.DoubleBuffered := True;
- pnlClient.DoubleBuffered := True;
- pnlWorkArea.DoubleBuffered := True;
- pnlLogout.DoubleBuffered := True;
- edFilterKeyword.DoubleBuffered := True;
- pnlWebSearch.DoubleBuffered := True;
- pnlWebSearchSplit.DoubleBuffered := True;
- pnlTeams.DoubleBuffered := True;
- pnlAll.DoubleBuffered := True;
- edLoginName.DoubleBuffered := True;
- edPassword.DoubleBuffered := True;
- pnlNDToolBar.DoubleBuffered := True;
- pnlNDStateBar.DoubleBuffered := True;
- pnlNetWorkFiles.DoubleBuffered := True;
- pnlMiddleClient.DoubleBuffered := True;
- pgcMultiWeb.DoubleBuffered := True;
- pnlToolBar.DoubleBuffered := True;
- FHintWindow := TSingleBorderHintWindow.Create(Self);
- FHintWindow.Visible := False;
- FGetUsersTask := TStringList.Create;
- //默认值
- ActiveButtonTag := 1;
- HotKeyID_ReadMessage := 0;
- HotKeyID_CopyScreen := 0;
- FShowGroup := False;
- FFlashCaptionOnOnline := True;
- FLVSelectedItemBorderColor := $00E9CAAD;
- FLVSelectedItemBorderInnerColor := $00F7F7F7;
- FLVSelectedItemBackColor := $00FEE9CE;
- FLVHeadImageBorderColor := $00E9CAAD;
- FLVHeadImageBackColor := clWhite;
- FLVStyle := lsMiddleHeadImage;
- FLVCaptionStyle := csDisplayName;
- FShowTree := False;
- LoadAutoUpdateConfigs;
- LoadDefaultConfigs;
- FFlashTrayIconIndex := 0;
- FFlashTrayIconIndexAtLogining := 0;
- FNotReadMessages := TStringList.Create;
- FGroups := TStringList.Create;
- FWebTabs := TList.Create;
- FFaceList := TStringList.Create;
- FTempFaceList := TStringList.Create;
- FFaceCategory := TStringList.Create;
- FInputFont := TFont.Create;
- FContacterListViews := TStringList.Create;
- FContacterTreeViews := TStringList.Create;
- FContacterTreeViews := TStringList.Create;
- FSystemMessages := TList.Create;
- //TMainFormController.GetController.ChangeStyle;
- try
- FDBHistory := TRealICQDBHistory.Create;
- except
- //ShowMessage('数据库创建失败');
-
on E: Exception do
- begin
- ShowMessage('异常类名称:' + E.ClassName + #13#10 + '异常信息:' + E.Message);
- end;
- end;
- FWebPanels := TStringList.Create;
- FOfflineAutoResponseTexts := TStringList.Create;
- FNotAddedEmployeeList := TStringList.Create;
- FSystemNotices := TList.Create;
- FToolBarButtonList := TStringList.Create;
- FToolBarButtonIconList := TStringList.Create;
- FManageGroupMsgList := TStringList.Create;
- FManageGroupMemberMsgList := TStringList.Create;
- FFriendInfo := TStringList.Create;
- FLoginAsSavePassword := False;
- FSavePassword := False;
- FAutoLogin := False;
- FLoginState := stOnline;
- FLeaveMessage := '';
- pnlMiddleClient.Align := alClient;
- pnlMiddleRight.Align := alRight;
- pnlAll.Constraints.MinWidth := pnlMiddleClient.Constraints.MinWidth;
- pnlAll.Constraints.MaxWidth := pnlMiddleClient.Constraints.MaxWidth;
- ChangeLanguage(ExtractFilePath(Application.ExeName) + 'Languages\简体中文.ini');
- {$region '生成显示系统消息的ListView'}
- AddContacterListView(pnlTemp, LVSystemMessage);
- FLVSystemMessage := FContacterListViews.Objects[0] as TRealICQContacterListView;
- FContacterListViews.Delete(0);
- FLVSystemMessage.DefaultPictureSmall.LoadFromFile(ExtractFilePath(Application.ExeName) + SystemMessagePicture);
- FLVSystemMessage.Style := lsSmallHeadImage;
- FLVSystemMessage.CaptionStyle := csDisplayName;
- FLVSystemMessage.PopupMenu := nil;
- FLVSystemMessage.OnItemOnline := nil;
- FLVSystemMessage.OnItemOffline := nil;
- FLVSystemMessage.OnItemMouseEnter := nil;
- FLVSystemMessage.OnItemMouseLeave := nil;
- FLVSystemMessage.OnItemIconButtonClick := nil;
- FLVSystemMessage.OnItemIconButtonDblClick := nil;
- FLVSystemMessage.ShowMobileButton := False;
- FLVSystemMessage.ShowTelButton := False;
- FLVSystemMessage.ShowEmailButton := False;
- FLVSystemMessage.ShowSMSButton := False;
- FLVSystemMessage.ShowCameraButton := False;
- FLVSystemMessage.ShowHeadImageButton := False;
- FLVSystemMessage.ShowHint := False;
- FLVSystemMessage.SelectedItemBackgroud.Graphic := nil;
- FLVSystemMessage.HeadImageBorderColor := clWhite;
- FLVSystemMessage.SelectedItemBorderInnerColor := clWhite;
- FLVSystemMessage.SelectedItemBackColor := clWhite;
- {$endregion}
- {$region '生成显示群组列表的ListView'}
- AddContacterListView(ScrollBoxTeam, LVTeams);
- // navForContacters.Groups[3] := LVTeams;
- FLVTeams := FContacterListViews.Objects[0] as TRealICQContacterListView;
- FContacterListViews.Delete(0);
- FLVTeams.AdjustPosition := False;
- FLVTeams.LeavePicture := nil;
- FLVTeams.DefaultPictureSmall.LoadFromFile(ExtractFilePath(Application.ExeName) + TeamPicture);
- FLVTeams.Style := lsSmallHeadImage;
- FLVTeams.CaptionStyle := csDisplayName;
- FLVTeams.PopupMenu := ppTeamListView;
- FLVTeams.OnItemOnline := nil;
- FLVTeams.OnItemOffline := nil;
- FLVTeams.OnItemMouseEnter := nil;
- FLVTeams.OnItemMouseLeave := nil;
- FLVTeams.OnItemIconButtonClick := nil;
- FLVTeams.OnItemIconButtonDblClick := nil;
- FLVTeams.ShowMobileButton := False;
- FLVTeams.ShowTelButton := False;
- FLVTeams.ShowEmailButton := False;
- FLVTeams.ShowSMSButton := False;
- FLVTeams.ShowCameraButton := False;
- FLVTeams.ShowHeadImageButton := False;
- pnlTeams.Parent := ScrollBoxTeam;
- pnlTeams.Align := alTop;
- pnlTeams.ShowHint := False;
- {$endregion}
- {$region '生成显示网络硬盘文件的ListView'}
- AddContacterListView(pnlNDFiles, '网络硬盘');
- FLVNetWorkDisk := FContacterListViews.Objects[0] as TRealICQContacterListView;
- FLVNetWorkDisk.Align := alClient;
- FContacterListViews.Delete(0);
- FLVNetWorkDisk.LeavePicture := nil;
- FLVNetWorkDisk.SelectedItemBackgroud.Graphic := nil;
- FLVNetWorkDisk.DefaultPictureSmall.LoadFromFile(ExtractFilePath(Application.ExeName) + BranchCollapsedBMP);
- FLVNetWorkDisk.Style := lsSmallHeadImage;
- FLVNetWorkDisk.CaptionStyle := csDisplayName;
- FLVNetWorkDisk.PopupMenu := ppNetWorkFile;
- FLVNetWorkDisk.HeadImageBorderColor := clWhite;
- FLVNetWorkDisk.SelectedItemBorderInnerColor := clWhite;
- FLVNetWorkDisk.SelectedItemBackColor := clWhite;
- FLVNetWorkDisk.OnItemOnline := nil;
- FLVNetWorkDisk.OnItemOffline := nil;
- FLVNetWorkDisk.OnItemMouseEnter := nil;
- FLVNetWorkDisk.OnItemMouseLeave := nil;
- FLVNetWorkDisk.OnItemIconButtonClick := nil;
- FLVNetWorkDisk.OnItemIconButtonDblClick := nil;
- FLVNetWorkDisk.ShowMobileButton := False;
- FLVNetWorkDisk.ShowTelButton := False;
- FLVNetWorkDisk.ShowEmailButton := False;
- FLVNetWorkDisk.ShowSMSButton := False;
- FLVNetWorkDisk.ShowCameraButton := False;
- FLVNetWorkDisk.ShowHeadImageButton := False;
- FLVNetWorkDisk.AdjustPosition := True;
- FLVNetWorkDisk.OnItemShowHint := ItemShowHint;
- FLVNetWorkDisk.OnItemDoubleClick := NDItemDoubleClick;
- FLVNetWorkDisk.OnSelectItemChanged := NDSelectItemChanged;
- FLVNetWorkDisk.OnItemClick := NDSelectItemChanged;
- FLVNetWorkDisk.OnItemMouseEnter := NDSelectItemChanged;
- FLVNetWorkDisk.OnDropFiles := NDMissionDropFiles;
- FLVNetWorkDisk.OnItemMouseDown := NDItemMouseDown;
- DragAcceptFiles(FLVNetWorkDisk.Handle, True);
- {$endregion}
- {$region '生成显示网络硬盘上传文件任务列表的ListView'}
- AddContacterListView(tsUploadingFiles, '硬盘上传文件');
- FLVNetWorkDiskUploadingFiles := FContacterListViews.Objects[0] as TRealICQContacterListView;
- FLVNetWorkDiskUploadingFiles.Align := alClient;
- FContacterListViews.Delete(0);
- FLVNetWorkDiskUploadingFiles.LeavePicture := nil;
- FLVNetWorkDiskUploadingFiles.SelectedItemBackgroud.Graphic := nil;
- FLVNetWorkDiskUploadingFiles.DefaultPictureSmall.LoadFromFile(ExtractFilePath(Application.ExeName) + BranchCollapsedBMP);
- FLVNetWorkDiskUploadingFiles.Style := lsSmallHeadImage;
- FLVNetWorkDiskUploadingFiles.CaptionStyle := csDisplayName;
- FLVNetWorkDiskUploadingFiles.PopupMenu := ppNetWorkMisson;
- FLVNetWorkDiskUploadingFiles.HeadImageBorderColor := clWhite;
- FLVNetWorkDiskUploadingFiles.SelectedItemBorderInnerColor := clWhite;
- FLVNetWorkDiskUploadingFiles.SelectedItemBackColor := clWhite;
- FLVNetWorkDiskUploadingFiles.OnItemOnline := nil;
- FLVNetWorkDiskUploadingFiles.OnItemOffline := nil;
- FLVNetWorkDiskUploadingFiles.OnItemMouseEnter := nil;
- FLVNetWorkDiskUploadingFiles.OnItemMouseLeave := nil;
- FLVNetWorkDiskUploadingFiles.OnItemIconButtonClick := NDMissionItemIconButtonClick;
- FLVNetWorkDiskUploadingFiles.OnItemIconButtonDblClick := nil;
- FLVNetWorkDiskUploadingFiles.ShowMobileButton := False;
- FLVNetWorkDiskUploadingFiles.ShowTelButton := False;
- FLVNetWorkDiskUploadingFiles.ShowEmailButton := False;
- FLVNetWorkDiskUploadingFiles.ShowSMSButton := False;
- FLVNetWorkDiskUploadingFiles.ShowCameraButton := False;
- FLVNetWorkDiskUploadingFiles.ShowHeadImageButton := False;
- FLVNetWorkDiskUploadingFiles.AdjustPosition := False;
- FLVNetWorkDiskUploadingFiles.OnItemShowHint := ItemShowHint;
- FLVNetWorkDiskUploadingFiles.OnItemDoubleClick := nil;
- FLVNetWorkDiskUploadingFiles.OnSelectItemChanged := nil;
- FLVNetWorkDiskUploadingFiles.OnItemClick := nil;
- FLVNetWorkDiskUploadingFiles.OnItemMouseEnter := nil;
- FLVNetWorkDiskUploadingFiles.ShowSMSButton := True;
- FLVNetWorkDiskUploadingFiles.SMSIcon.LoadFromFile(ExtractFilePath(Application.ExeName) + CancelIcon);
- {$endregion}
-
- {$region '生成显示网络硬盘下载文件任务列表的ListView'}
- AddContacterListView(tsDownloadingFiles, '硬盘下载文件');
- FLVNetWorkDiskDownloadingFiles := FContacterListViews.Objects[0] as TRealICQContacterListView;
- FLVNetWorkDiskDownloadingFiles.Align := alClient;
- FContacterListViews.Delete(0);
- FLVNetWorkDiskDownloadingFiles.LeavePicture := nil;
- FLVNetWorkDiskDownloadingFiles.SelectedItemBackgroud.Graphic := nil;
- FLVNetWorkDiskDownloadingFiles.DefaultPictureSmall.LoadFromFile(ExtractFilePath(Application.ExeName) + BranchCollapsedBMP);
- FLVNetWorkDiskDownloadingFiles.Style := lsSmallHeadImage;
- FLVNetWorkDiskDownloadingFiles.CaptionStyle := csDisplayName;
- FLVNetWorkDiskDownloadingFiles.PopupMenu := ppNetWorkMisson;
- FLVNetWorkDiskDownloadingFiles.HeadImageBorderColor := clWhite;
- FLVNetWorkDiskDownloadingFiles.SelectedItemBorderInnerColor := clWhite;
- FLVNetWorkDiskDownloadingFiles.SelectedItemBackColor := clWhite;
- FLVNetWorkDiskDownloadingFiles.OnItemOnline := nil;
- FLVNetWorkDiskDownloadingFiles.OnItemOffline := nil;
- FLVNetWorkDiskDownloadingFiles.OnItemMouseEnter := nil;
- FLVNetWorkDiskDownloadingFiles.OnItemMouseLeave := nil;
- FLVNetWorkDiskDownloadingFiles.OnItemIconButtonClick := NDMissionItemIconButtonClick;
- FLVNetWorkDiskDownloadingFiles.OnItemIconButtonDblClick := nil;
- FLVNetWorkDiskDownloadingFiles.ShowMobileButton := False;
- FLVNetWorkDiskDownloadingFiles.ShowTelButton := False;
- FLVNetWorkDiskDownloadingFiles.ShowEmailButton := False;
- FLVNetWorkDiskDownloadingFiles.ShowSMSButton := False;
- FLVNetWorkDiskDownloadingFiles.ShowCameraButton := False;
- FLVNetWorkDiskDownloadingFiles.ShowHeadImageButton := False;
- FLVNetWorkDiskDownloadingFiles.AdjustPosition := False;
- FLVNetWorkDiskDownloadingFiles.OnItemShowHint := ItemShowHint;
- FLVNetWorkDiskDownloadingFiles.OnItemDoubleClick := nil;
- FLVNetWorkDiskDownloadingFiles.OnSelectItemChanged := nil;
- FLVNetWorkDiskDownloadingFiles.OnItemClick := nil;
- FLVNetWorkDiskDownloadingFiles.OnItemMouseEnter := nil;
- FLVNetWorkDiskDownloadingFiles.ShowSMSButton := True;
- FLVNetWorkDiskDownloadingFiles.SMSIcon.LoadFromFile(ExtractFilePath(Application.ExeName) + CancelIcon);
- {$endregion}
- iIndex := AddContacterListView(tsCustomers, '客服人员');
- FLVCustomers := FContacterListViews.Objects[iIndex] as TRealICQContacterListView;
- FContacterListViews.Delete(iIndex);
- FLVCustomers.AdjustPosition := False;
- FLVCustomers.OnItemOnline := nil;
- FLVCustomers.OnItemOffline := nil;
- FLVCustomers.Style := lsSmallHeadImage;
- FLVCustomers.Parent := tsCustomers;
- FLVCustomers.OnHeadImageMouseEnter := ItemOnHeadImageEnter;
- FLVCustomers.OnHeadImageMouseLeave := ItemOnHeadImageLeave;
- iIndex := AddContacterListView(ScrollBoxLatests, LVLatests);
- FLVLatests := FContacterListViews.Objects[iIndex] as TRealICQContacterListView;
- FLVLatests.AdjustPosition := False;
- FLVLatests.OnItemOnline := nil;
- FLVLatests.OnItemOffline := nil;
- FLVLatests.Parent := ScrollBoxLatests;
- FLVLatests.OnHeadImageMouseEnter := ItemOnHeadImageEnter;
- FLVLatests.OnHeadImageMouseLeave := ItemOnHeadImageLeave;
- iIndex := AddContacterListView(ScrollBoxSearchMoreUser, LVMoreUsers);
- FSearchListView := FContacterListViews.Objects[iIndex] as TRealICQContacterListView;
- FSearchListView.OnItemOnline := nil;
- FSearchListView.OnItemOffline := nil;
- FSearchListView.OnItemIconButtonClick := nil;
- FSearchListView.OnHeadImageMouseEnter := ItemOnHeadImageEnter;
- FSearchListView.OnHeadImageMouseLeave := ItemOnHeadImageLeave;
- FSearchListView.ShowTelButton := False;
- FSearchListView.ShowCameraButton := False;
- FSearchListView.ShowEmailButton := False;
- FSearchListView.AdjustPosition := False;
- iIndex := AddContacterListView(ScrollBoxSearchUser, LVSearch);
- FSearchListView := FContacterListViews.Objects[iIndex] as TRealICQContacterListView;
- FSearchListView.OnItemOnline := nil;
- FSearchListView.OnItemOffline := nil;
- ChangeUIColor(UIMainColor);
- PostMessage(Handle, WM_SIZE, 0, 0);
- Application.ProcessMessages;
- Sleep(200);
- SetUIState;
- AddWebBrowserToPageControl('about:blank', -2);
- lblWeatherCity.Transparent := True;
- lblWeather.Transparent := True;
- lblWeatheren.Transparent := True;
- //扩展标签开始
- FToolBarButtonList.AddObject(LVMyContacters, MyContacters);
- FToolBarButtonList.AddObject(LVMoreUsers, SysMsg);
- FToolBarButtonList.AddObject(LVFriends, MyFriend);
- FToolBarButtonList.AddObject(LvTeams, MyTeam);
- FToolBarButtonList.AddObject(LvLatests, Latests);
- FToolBarButtonIconList.AddObject(LVMyContacters, MyContactersIcon);
- FToolBarButtonIconList.AddObject(LVMoreUsers, SysMsgIcon);
- FToolBarButtonIconList.AddObject(LVFriends, MyFriendIcon);
- FToolBarButtonIconList.AddObject(LvTeams, MyTeamIcon);
- FToolBarButtonIconList.AddObject(LvLatests, LatestsIcon);
- //扩展标签结束
- //未读消息
- NotReadMessageBoxForm := TNotReadMessageBoxForm.Create(Self);
- NotReadMessageBoxForm.Left := -1000;
- NotReadMessageBoxForm.Top := -1000;
- NotReadMessageBoxForm.Show;
- NotReadMessageBoxForm.Hide;
- tsContactersShow(tsContacters);
- if RealICQClient.CaEnable and (ParamStr(1) = 'wscc://sso') then
- begin
- ca := DecodeString(ParamStr(2));
- ca := URLDecode(ca);
- //ca := copy(ca,pos('ca=',ca)+3,length(ca));
-
Sends := TStringList.Create;
- IdHttp := TIdHTTP.Create(nil);
- try
- ResponeStr := Idhttp.post('http://' + RealICQClient.CaServerAddress + ':' + inttostr(RealICQClient.CaPort) + '/api/Structure/LoginByCA?ca=' + ca, Sends);
- ResponeStr := UTF8Decode(ResponeStr);
- try
- jo := SO(ResponeStr);
- CALoginName := jo['data.loginName'].AsString;
- CAPassWord := jo['data.password'].AsString;
- except
- end;
- finally
- Freeandnil(IdHttp);
- Sends.Free;
- end;
- if not UserIsLogined(CALoginName) then
- RealICQClient.Login(CALoginName, CAPassWord, FLoginState, FLeaveMessage, FSavePassword, False, True)
- else
- begin
- try
- Application.Terminate;
- except
- end;
- end;
- end
- else
- begin
- FAutoLogin := RealICQClient.AutoLogin;
- FSavePassword := RealICQClient.SavedPassword;
- SetLoginStateControlState;
- if RealICQClient.AutoLogin and (RealICQClient.SavedPassword or RealICQClient.CALogin) then
- RealICQClient.LoginAsSaved;
- end;
- //调整大小解决右边框被覆盖问题
- DisableAlign;
- try
- PostMessage(Handle, WM_SIZE, 0, 0);
- Height := Height - 1;
- Height := Height + 1;
- finally
- EnableAlign;
- end;
- tsCustomerService.PageControl := nil;
- RealICQClient.OnGettedSysMsgInterfaces := RealICQClientGettedSysMsgInterfaces;
- Application.ProcessMessages;
- except
- on E: Exception do
- Error(E.Message, 'TMainForm.FormCreate');
- end;
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.FormDeactivate(Sender: TObject);
- begin
- if edWatchword.Visible then
- edWatchwordExit(edWatchword);
- //debug('FormDeactivate','TMainForm.FormDeactivate');
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.FormDestroy(Sender: TObject);
- begin
- try
- if RealICQClient.Connected then
- RealICQClient.Logout;
- if AThreadPool <> nil then
- AThreadPool.TerminateAllYarns;
- //FreeAndNil(FDownFile);
- FHintWindow.ReleaseHandle;
- FHintWindow.Free;
- FGetUsersTask.Clear;
- FreeAndNil(FGetUsersTask);
- FServerInfoList.Clear;
- FreeAndNil(FServerInfoList);
- // FreeAndNil(FPCAMessage);
- FreeAndNil(FOfflineAutoResponseTexts);
- FNotAddedEmployeeList.Clear;
- FreeAndNil(FNotAddedEmployeeList);
- FSystemMessages.Clear;
- FreeAndNil(FSystemMessages);
- FToolBarButtonList.Clear;
- FreeAndNil(FToolBarButtonList);
- FToolBarButtonIconList.Clear;
- FreeAndNil(FToolBarButtonIconList);
- FNotReadMessages.Clear;
- FreeAndNil(FNotReadMessages);
- FContacterListViews.Clear;
- FreeAndNil(FContacterListViews);
- FContacterTreeViews.Clear;
- FreeAndNil(FContacterTreeViews);
- FWebTabs.Clear;
- FreeAndNil(FWebTabs);
- FGroups.Clear;
- FreeAndNil(FGroups);
- FFriendInfo.Clear;
- FreeAndNil(FFriendInfo);
- FManageGroupMsgList.Clear;
- FreeAndNil(FManageGroupMsgList);
- FManageGroupMemberMsgList.Clear;
- FreeAndNil(FManageGroupMemberMsgList);
- while FWebPanels.Count > 0 do
- begin
- try
- FWebPanels.Objects[0].Free;
- except
- end;
- FWebPanels.Delete(0);
- end;
- FWebPanels.Clear;
- FreeAndNil(FWebPanels);
- while FSystemNotices.Count > 0 do
- begin
- try
- TSystemNotices(FSystemNotices[0]).Free;
- except
- end;
- FSystemNotices.Delete(0);
- end;
- FSystemNotices.Clear;
- FreeAndNil(FSystemNotices);
- while FFaceList.Count > 0 do
- begin
- try
- FFaceList.Objects[0].Free;
- except
- end;
- FFaceList.Delete(0);
- end;
- FFaceList.Clear;
- FreeAndNil(FFaceList);
- while FTempFaceList.Count > 0 do
- begin
- try
- FTempFaceList.Objects[0].Free;
- except
- end;
- FTempFaceList.Delete(0);
- end;
- FTempFaceList.Clear;
- FreeAndNil(FTempFaceList);
- FFaceCategory.Clear;
- FreeAndNil(FFaceCategory);
- FreeAndNil(FInputFont);
- FreeAndNil(FDBHistory);
- if HookID <> 0 then
- UnHookWindowsHookEx(HookID);
- if HotKeyID_ReadMessage <> 0 then
- begin
- UnregisterHotKey(Handle, HotKeyID_ReadMessage);
- DeleteAtom(HotKeyID_ReadMessage);
- end;
- if HotKeyID_CopyScreen <> 0 then
- begin
- UnregisterHotKey(Handle, HotKeyID_CopyScreen);
- DeleteAtom(HotKeyID_CopyScreen);
- end;
- finally
- GetDataModule.Uninstall;
- end;
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.FormResize(Sender: TObject);
- var
- iLoop: Integer;
- ContacterTreeView: TRealICQContacterTreeView;
- FriendTreeView: TRealICQContacterTreeView;
- ListView: TRealICQContacterListView;
- begin
- ShowMeInformation;
- if FContacterTreeViews = nil then
- Exit;
- for iLoop := 0 to FContacterTreeViews.Count - 1 do
- begin
- ContacterTreeView := FContacterTreeViews.Objects[iLoop] as TRealICQContacterTreeView;
- ContacterTreeView.ReDrawAll;
- end;
- {for iLoop := 0 to FContacterTreeViews.Count - 1 do
- begin
- FriendTreeView := FContacterTreeViews.Objects[iLoop] as TRealICQContacterTreeView;
- FriendTreeView.ReDrawAll;
- end; }
- for iLoop := 0 to FContacterListViews.Count - 1 do
- begin
- ListView := FContacterListViews.Objects[iLoop] as TRealICQContacterListView;
- ListView.ReDrawAll;
- end;
- if FLVNetWorkDisk <> nil then
- FLVNetWorkDisk.ReDrawAll;
- if FTVCustomerLatests <> nil then
- FTVCustomerLatests.ReDrawAll;
- pnlSearchMoreUser.Width := pnlSelectServer.Width - 5;
- ImgLogining.Left := (pnlSearchMoreUser.Width - ImgLogining.Width) div 2;
- { TODO -olqq -c : 二维码居中 2014/12/14 11:05:27 }
- ImgApp.Left := (Self.Width - ImgApp.Width - 26) div 2;
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.SaveWindowState;
- begin
- if WindowState <> wsMaximized then
- begin
- FMainFormLeft := Left;
- FMainFormTop := Top;
- FMainFormHeight := Height;
- FMainFormWidth := Width - pnlMiddleRight.Width;
- try
- SaveDefaultConfigs;
- except
- end;
- end;
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.sbpNewWebTabClick(Sender: TObject);
- begin
- AddWebBrowserToPageControl('about:blank', -1);
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.sbpSMSClick(Sender: TObject);
- begin
- OpenSMSForm('', True);
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.FormShow(Sender: TObject);
- var J:Integer;
- begin
- try
- //tsCustomers.Parent := nil;
- //tsCustomers.PageControl := nil;
- //pgcMainWorkArea.RemoveControl(tsCustomers);
- //FreeAndNil(tsCustomers);
-
// Repaint;
-
// for J := 0 to Self.ControlCount -1 do
-
// if (Self.Controls[J] is TRealICQContacterTreeView) then
-
// Self.Controls[J].Repaint;
- except
- end;
- //tsNetWorkDisk.Parent := nil;
- //tsNetWorkDisk.PageControl := nil;
- //pgcMainWorkArea.RemoveControl(tsNetWorkDisk);
- //FreeAndNil(tsNetWorkDisk);
- ClearMemory;
- actOpenMainForm.Execute;
- end;
- procedure TMainForm.FormClose(Sender: TObject; var Action: TCloseAction);
- begin
- if FSearchListViewInVisible then
- begin
- edFilterKeyword.Text := '';
- edFilterKeyword.Font.Color := clGray;
- end;
- Action := caNone;
- if pnlMiddleRight.Visible then
- begin
- ShowOrHideMuiltiWeb;
- Exit;
- end;
- ZoomEffect(Self, zaMinimize);
- ShowWindow(Handle, SW_HIDE);
- FHidden := true;
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
- begin
- SaveWindowState;
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.actLoginExecute(Sender: TObject);
- begin
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.actRegExecute(Sender: TObject);
- begin
- if RegForm <> nil then
- Exit;
- RegForm := TRegForm.Create(Self);
- try
- if RegForm.ShowModal <> mrOK then
- begin
- RealICQClient.CancelReg;
- end;
- finally
- FreeAndNil(RegForm);
- end;
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.actDelFriendExecute(Sender: TObject);
- var
- ItemIndex: Integer;
- RealICQFriendTreeView: TRealICQContacterTreeView;
- Friend: TRealICQEmployee;
- begin
- if MessageBox(Handle, '确实要将选中的用户从好友列表中删除吗？', '确认删除', MB_OKCANCEL or MB_ICONQUESTION) <> IDOK then
- Exit;
- ItemIndex := FContacterTreeViews.IndexOf(LVFriends);
- RealICQFriendTreeView := FContacterTreeViews.Objects[ItemIndex] as TRealICQContacterTreeView;
- Friend := RealICQFriendTreeView.GetSelectedEmployee;
- if (Friend <> nil) then
- begin
- if Friend.BranchID = LVFriends then
- RealICQClient.DelFriend(Friend.LoginName);
- end;
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.actRemoveUserExecute(Sender: TObject);
- var
- ItemIndex: Integer;
- GroupName: string;
- RealICQFriendTreeView: TRealICQContacterTreeView;
- Friend: TRealICQEmployee;
- MenuItem: TMenuItem;
- begin
- ItemIndex := FContacterTreeViews.IndexOf(LVFriends);
- RealICQFriendTreeView := FContacterTreeViews.Objects[ItemIndex] as TRealICQContacterTreeView;
- Friend := RealICQFriendTreeView.GetSelectedEmployee;
- if Friend = nil then
- Exit;
- GroupName := Friend.BranchID;
- if MessageBox(Handle, PChar('确实要将选中的用户从' + GroupName + '删除吗？'), '确认删除', MB_OKCANCEL or MB_ICONQUESTION) <> IDOK then
- Exit;
- if FShowGroup and (FGroups.IndexOf(GroupName) <> -1) then
- begin
- // MenuItem := miGroup.Find(LVFriends);
- // miMoveGroupClick(MenuItem);
- exit;
- end;
- {
- Screen.Cursor := crHourGlass;
- Application.ProcessMessages;
- try
- if GroupName = lvBlacklists then
- begin
- RealICQClient.DelBlacklists(Friend.LoginName);
- ShowAddFriendWindow(Self, Friend.LoginName, Friend.DisplayName);
- Sleep(15);
- end;
- finally
- Screen.Cursor := crDefault;
- end;
- }
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.actLogoutExecute(Sender: TObject);
- var
- ShellPath: string;
- begin
- if GetTalkingFormCount > 0 then
- begin
- if MessageBox(Handle, '确实要注销吗，此操作将会关闭所有的对话窗口！', '提示', MB_ICONINFORMATION or MB_OKCANCEL) = ID_CANCEL then
- Exit;
- CloseAllTalkingForm;
- end;
- CloseAllSMSForm;
- RealICQClient.Logout;
- RealICQClient.FriendCount := 0;
- FIsLogout := True;
- ShellPath:= ExtractFilePath(paramstr(0)) + 'Online.exe';
- if FileExists(ShellPath) then
- WinExec(PChar(ShellPath + ' /R ' + '"' + Application.ExeName + '"'), SW_SHOW);
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.actLoginAsExecute(Sender: TObject);
- begin
- if RegForm <> nil then
- begin
- MessageBox(RegForm.Handle, '请先关闭新用户注册窗口', '提示', MB_ICONINFORMATION);
- Exit;
- end;
- RealICQClient.LoginAsSaved;
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.actOfflieAutoResponseExecute(Sender: TObject);
- begin
- if OptionsForm <> nil then
- Exit;
- OptionsForm := TOptionsForm.Create(Self);
- try
- OptionsForm.PageIndex := 10;
- OptionsForm.ShowModal;
- finally
- FreeAndNil(OptionsForm);
- end;
- end;
- procedure TMainForm.actOnlineExecute(Sender: TObject);
- begin
- RealICQClient.ChangeState(TRealICQLoginState((Sender as TAction).Tag), (Sender as TAction).Caption);
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.actHiddenExecute(Sender: TObject);
- begin
- RealICQClient.ChangeState(stHidden, '');
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.actLeaveExecute(Sender: TObject);
- begin
- RealICQClient.ChangeState(stLeave, (Sender as TAction).Caption);
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.actHelpExecute(Sender: TObject);
- begin
- //ShellExecute(handle,'open',pchar('C:\Program Files\Internet Explorer\IEXPLORE.EXE'),PChar('http://www.lxtalk.com'),'',SW_SHOWMAXIMIZED);
- //ShellExecute(handle, 'open',PChar(GetDefaultBrowser), PChar('http://www.lxtalk.com'),'',SW_SHOWMAXIMIZED);
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.actOtherStateExecute(Sender: TObject);
- var
- LeaveMessage: string;
- begin
- LeaveMessage := Trim(ShowMyInputBox('其它状态', '请输入离开状态说明文字', '', 16));
- if Length(LeaveMessage) > 0 then
- RealICQClient.ChangeState(stLeave, LeaveMessage);
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.RealICQClientLoginResult(Sender: TObject; LoginResultType: TRealICQLoginResultType; ResultMessage: string);
- var
- hwnd: THandle;
- DBFileName: string;
- RemoteVersion: string;
- RemoteKeylist: string;
- begin
- TimerForLogining.Enabled := False;
- if not FCheckedUpdate then
- begin
- if not FileExists(ExtractFilePath(paramstr(0)) + 'Online.exe') then
- DownLoadUpdateConfig
- else
- WinExec(PChar(ExtractFilePath(paramstr(0)) + 'Online.exe /S0 /C /Q'), SW_SHOW);
- end;
- FCheckedUpdate := not FCheckedUpdate;
- case LoginResultType of
- rtLoginOK, rtCanUpdate:
- begin
- Success('成功连接服务器!', 'TMainForm.RealICQClientLoginResult');
- AddMessageHistory(smSimple, '登录至服务器', nil);
- lblLoginState.Caption := '已登录，数据下载中...';
- lblLoginState.Refresh;
- lblNDState.Caption := RealICQClient.NetWorkDiskServerAddress + '(' + IntToStr(RealICQClient.NetWorkDiskServerPort) + ')';
- DBFileName := RealICQClient.GetUserDir + PersonalMessageHistoryDBFile;
- if not FileExists(DBFileName) then
- CopyFile(PChar(ExtractFilePath(paramstr(0)) + MessageHistoryDBFile), PChar(DBFileName), False);
- try
- FDBHistory.LoginName := RealICQClient.LoginName;
- FDBHistory.DBFileName := DBFileName;
- except
- on E: Exception do
- begin
- Error(E.Message, '加载本地数据库失败');
- end;
- end;
- // btShowMiniPage.Visible := RealICQClient.ShowMiniPage;
- if RealICQClient.WorkingMode = wmPublic then
- begin
- {$region 'wmPublic工作模式'}
- { AddContacterListView(navForContacters.Groups.Objects[0] as TScrollBox, LVFriends);
- navForContacters.Groups[0] := LVFriends;
- AddContacterListView(navForContacters.Groups.Objects[1] as TScrollBox, LVStrangers);
- navForContacters.Groups[1] := LVStrangers;
- AddContacterListView(navForContacters.Groups.Objects[2] as TScrollBox, LVBlacklists);
- navForContacters.Groups[2] := LVBlacklists; }
- {$endregion}
-
//debug('wmPublic','TMainForm.RealICQClientLoginResult');
-
end
- else if RealICQClient.WorkingMode = wmCorporation then
- begin
- {$region 'wmCorporation'}
-
FShowGroup := False;
- AddFriendTreeView(ScrollBoxMyFriend, LVFriends);
- AddContacterTreeView(ScrollBoxContacters, LVMyContacters);
- AddContacterTreeView(ScrollBoxAddrBook, LVAddrBook);
- //产品类型
- FProductType := TRealICQProductType(TConditionConfig.GetConfig.ProductType);
- // LQQ
- // 把请求当前用户从RealICQClient移动到BranchService
- TMessagesHander.GetHander.Init;
- {$endregion}
-
//debug('wmCorporation','TMainForm.RealICQClientLoginResult');
-
end;
- try
- TTeamsAdapter.Start(RealICQClient.LoginName);
- TGroupShareConfig.GetConfig.URL := RealICQClient.HeadImageURL;
- btShowMiniPage.Visible := TCustomerConfig.GetConfig.ShowGuideViewBtn;
- //用户类型
- FUserType := RealICQClient.LoginUserType;
- //关键字过滤
- FFilter := TFilterConfig.GetConfig.Filter;
- if FFilter then
- begin
- RemoteVersion := HttpGet(TFilterConfig.GetConfig.Version, 1);
- if TFilterConfig.GetConfig.Local <> RemoteVersion then
- begin
- RemoteKeylist := HttpGet(TFilterConfig.GetConfig.Keyword, 1);
- TFilterConfig.GetConfig.SaveKeylist(RemoteKeylist);
- TFilterConfig.GetConfig.Local := RemoteVersion;
- end;
- FKeyList := TFilterConfig.GetConfig.Keylist;
- end;
- TMainFormController.GetController.ChangeStyle;
- TMainFormController.GetController.LoginToAppCentre(RealICQClient.LoginName);
- pnlToolBarResize(nil);
- except
- on E: Exception do
- begin
- Error(E.Message, 'TMainForm.RealICQClientLoginResult');
- end;
- end;
- end;
- // rtMustUpdate:
- // begin
- // //启动升级程序
-
// hWnd := FindWindow(pchar('TUpdateFrm'), pchar(trim('自动更新')));
- // if hWnd = 0 then
- // WinExec('Update.exe', SW_SHOW);
- // end;
- // rtVersionError:
- // MessageBox(Handle, '抱歉，您当前使用的客户端版本不受支持', '登录失败', MB_ICONINFORMATION);
- // rtLoginErrorByDisplayName:
- // MessageBox(Handle, '存在姓名相同的用户，请使用登录名登录！', '登录失败', MB_ICONINFORMATION);
- rtAuthorizationError:
- begin
- MessageBox(Handle, '用户名或密码错误', '登录失败', MB_ICONINFORMATION);
- RealICQClient.ClearSavedPassword;
- actLoginAs.Visible := False;
- SetLoginControlsVisible(True);
- end;
- rtOther:
- MessageBox(Handle, PChar(ResultMessage), '登录失败', MB_ICONINFORMATION);
- end;
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.RealICQClientLoginStateChanged(Sender: TObject);
- begin
- if not RealICQClient.Logined then
- TimerForCheckLogoutTimeout.Enabled := False;
- SetUIState;
- ClearMemory;
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.RealICQClientPleaseSendFaceToMe(Sender: TObject; ALoginName, AFaceMD5Code: string);
- var
- iIndex: Integer;
- Face: TFace;
- begin
- iIndex := FFaceList.IndexOf(AFaceMD5Code);
- if iIndex >= 0 then
- begin
- Face := FFaceList.Objects[iIndex] as TFace;
- (Sender as TRealICQClient).SendFile(MainForm.UseCacheDir, MainForm.CacheDir, ALoginName, Face.FileName, foFace);
- Exit;
- end;
- iIndex := FTempFaceList.IndexOf(AFaceMD5Code);
- if iIndex >= 0 then
- begin
- Face := FTempFaceList.Objects[iIndex] as TFace;
- (Sender as TRealICQClient).SendFile(MainForm.UseCacheDir, MainForm.CacheDir, ALoginName, Face.FileName, foFace);
- Exit;
- end;
- if FileExists(FindRecvedFace(AFaceMD5Code)) then
- begin
- (Sender as TRealICQClient).SendFile(MainForm.UseCacheDir, MainForm.CacheDir, ALoginName, FindRecvedFace(AFaceMD5Code), foFace);
- Exit;
- end
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.RealICQClientPleaseUploadTeamFace(Sender: TObject; MD5String: string; var FileName: string);
- var
- iIndex: Integer;
- Face: TFace;
- begin
- iIndex := FFaceList.IndexOf(MD5String);
- if iIndex >= 0 then
- begin
- Face := FFaceList.Objects[iIndex] as TFace;
- FileName := Face.FileName;
- Exit;
- end;
- iIndex := FTempFaceList.IndexOf(MD5String);
- if iIndex >= 0 then
- begin
- Face := FTempFaceList.Objects[iIndex] as TFace;
- FileName := Face.FileName;
- Exit;
- end;
- if FileExists(FindRecvedFace(MD5String)) then
- begin
- FileName := FindRecvedFace(MD5String);
- Exit;
- end
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.RealICQClientReConnectExecute(Sender: TObject; ASeconds: Integer);
- begin
- TimerForLogining.Enabled := False;
- TrayIcon.Icon.LoadFromFile(ExtractFilePath(Application.ExeName) + 'Images\State\TrayIcon\Offline.ico');
- TrayIcon.SetDefaultIcon;
- lblLoginState.Caption := '连接已中断' + #$D#$A + IntToStr(ASeconds) + ' 秒后重新建立连接。';
- lblLoginState.Visible := True;
- SetLoginControlsVisible(False);
- if not btLogin.Visible then
- begin
- btLogin.Visible := True;
- btLogin.Caption := '取消(&C)';
- btLogin.Refresh;
- end;
- lblReConnect.Visible := True;
- TimerForCheckLogoutTimeout.Enabled := False;
- if not RealICQClient.ReConnectExecuting then
- RealICQClient.CancelReConnectAndLogin;
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.RealICQClientRemovedUser(Sender: TObject; ALoginName: string);
- var
- itemIndex: Integer;
- RealICQFriendTreeView: TRealICQContacterTreeView;
- // Friend: TRealICQEmployee;
- // Node: TTreeNode;
- begin
- ItemIndex := FContacterTreeViews.IndexOf(LVFriends);
- if ItemIndex >= 0 then
- begin
- RealICQFriendTreeView := FContacterTreeViews.Objects[ItemIndex] as TRealICQContacterTreeView;
- ItemIndex := RealICQFriendTreeView.EmployeeItems.IndexOf(ALoginName);
- if ItemIndex >= 0 then
- RealICQFriendTreeView.EmployeeItems.Delete(ItemIndex);
- end;
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.TimerForFlashTrayIconTimer(Sender: TObject);
- var
- Icon: TIcon;
- Bitmap: TBitmap;
- MessageID: string;
- RealICQUser: TRealICQUser;
- begin
- if FNotReadMessages.Count = 0 then
- begin
- NotReadMessageBoxForm.Visible := False;
- TimerForFlashTrayIcon.Enabled := False;
- ShowMeInformation;
- Exit;
- end;
- if not (RealICQClient.Logined and RealICQClient.Connected) then
- begin
- TimerForFlashTrayIcon.Enabled := False;
- NotReadMessageBoxForm.Visible := False;
- Exit;
- end;
- Icon := nil;
- Bitmap := nil;
- MessageID := FNotReadMessages.Strings[FNotReadMessages.Count - 1];
- if AnsiSameStr(Copy(MessageID, 1, Length(SMSMessageID)), SMSMessageID) then
- begin
- Icon := TIcon.Create;
- Icon.LoadFromFile(ExtractFilePath(Application.ExeName) + SMSMessageIcon);
- end
- else if AnsiSameStr(Copy(MessageID, 1, Length(TeamMessageID)), TeamMessageID) then
- begin
- Icon := TIcon.Create;
- Icon.LoadFromFile(ExtractFilePath(Application.ExeName) + TeamIcon);
- end
- else if AnsiSameStr(Copy(MessageID, 1, Length(SystemMessageID)), SystemMessageID) then
- begin
- Icon := TIcon.Create;
- Icon.LoadFromFile(ExtractFilePath(Application.ExeName) + SystemMessageIcon);
- end
- else
- begin
- RealICQUser := TUsersService.GetUsersService.GetOrRequestUser(MessageID);
- if FileExists(RealICQUser.HeadImageFile) then
- begin
- try
- Bitmap := GetSamllBitmap(RealICQUser.HeadImageFile, 16, 16, False);
- except
- Icon := TIcon.Create;
- Icon.LoadFromFile(ExtractFilePath(Application.ExeName) + DefaultIcon);
- end;
- end
- else
- begin
- Icon := TIcon.Create;
- Icon.LoadFromFile(ExtractFilePath(Application.ExeName) + DefaultIcon);
- end;
- end;
- try
- while ImgLstForFlashTrayIcon.Count > 1 do
- ImgLstForFlashTrayIcon.Delete(1);
- if Icon <> nil then
- ImgLstForFlashTrayIcon.AddIcon(Icon)
- else if Bitmap <> nil then
- ImgLstForFlashTrayIcon.Add(Bitmap, nil);
- finally
- try
- FreeAndNil(Bitmap);
- FreeAndNil(Icon);
- except
- end;
- end;
- ImgLstForFlashTrayIcon.GetIcon(FFlashTrayIconIndex, TrayIcon.Icon);
- TrayIcon.SetDefaultIcon;
- if FFlashTrayIconIndex <> 0 then
- FFlashTrayIconIndex := 0
- else
- FFlashTrayIconIndex := 1;
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.TimerForLoginingTimer(Sender: TObject);
- begin
- ImgLstForLogining.GetIcon(FFlashTrayIconIndexAtLogining, TrayIcon.Icon);
- TrayIcon.SetDefaultIcon;
- Inc(FFlashTrayIconIndexAtLogining);
- if FFlashTrayIconIndexAtLogining >= ImgLstForLogining.Count then
- FFlashTrayIconIndexAtLogining := 0;
- // TrayIcon.Icon.LoadFromFile(ExtractFilePath(Application.ExeName) + 'Images\State\TrayIcon\Offline.ico');
- // TrayIcon.SetDefaultIcon;
-
end;
- procedure TMainForm.TimerForreconnectgroupTimer(Sender: TObject);
- begin
- if (realICQClient.Logined and realICQClient.Connected) then
- begin
- { TODO -olqq -c : 重连的时候，做下异常处理 2014/12/12 15:36:23 }
- try
- TTeamsAdapter.Start(RealICQClient.LoginName);
- { TODO -olqq -c : 在procedure TGroup.OnOpen中有重复 2014/12/12 15:41:02 }
- //WebSocketTeamSubscribe;
- except
- on E: Exception do
- Log(E.Message, 'TMainForm.TimerForreconnectgroupTimer');
- end;
- end;
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.StopFlashTeam(ATeamID: string);
- var
- ItemIndex: Integer;
- ListItem: TRealICQContacterListItem;
- begin
- ItemIndex := FLVTeams.Items.IndexOf(ATeamID);
- if ItemIndex >= 0 then
- begin
- ListItem := FLVTeams.Items.Objects[ItemIndex] as TRealICQContacterListItem;
- ListItem.StopFlash;
- end;
- end;
- procedure TMainForm.StopHeadImageFlash(AID: string);
- var
- ItemIndex: Integer;
- ListItem: TRealICQContacterListItem;
- begin
- ItemIndex := FLVTeams.Items.IndexOf(AID);
- if ItemIndex >= 0 then
- begin
- ListItem := FLVTeams.Items.Objects[ItemIndex] as TRealICQContacterListItem;
- ListItem.StopFlash();
- end;
- end;
- procedure TMainForm.SysMsgClick(Sender: TObject);
- begin
- RealICQClient.SendGetMoreServerList;
- end;
- procedure TMainForm.SysMsgIconClick(Sender: TObject);
- begin
- RealICQClient.SendGetMoreServerList;
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.StopFlash(ALoginName: string);
- var
- ItemIndex: Integer;
- RealICQContacterListView: TRealICQContacterListView;
- RealICQContacterListItem: TRealICQContacterListItem;
- RealICQFriendTreeView: TRealICQContacterTreeView;
- RealICQContacterTreeView: TRealICQContacterTreeView;
- Employee: TRealICQEmployee;
- Friend: TRealICQEmployee;
- begin
- ItemIndex := FSearchListView.Items.IndexOf(ALoginName);
- if ItemIndex >= 0 then
- begin
- RealICQContacterListItem := FSearchListView.Items.Objects[ItemIndex] as TRealICQContacterListItem;
- RealICQContacterListItem.StopFlash;
- end;
- if (RealICQClient.WorkingMode = wmCorporation) or (FShowTree and (TFriendsService.GetService.IsFriend(ALoginName)) and (TWorkmatesService.GetService.IsWorkmate(ALoginName))) then
- begin
- ItemIndex := FContacterTreeViews.IndexOf(LVMyContacters);
- RealICQContacterTreeView := FContacterTreeViews.Objects[ItemIndex] as TRealICQContacterTreeView;
- if RealICQContacterTreeView <> nil then
- begin
- Employee := RealICQContacterTreeView.GetEmployee(ALoginName);
- if Employee <> nil then
- Employee.StopFlash
- else
- begin
- ItemIndex := FContacterTreeViews.IndexOf(LVFriends);
- RealICQFriendTreeView := FContacterTreeViews.Objects[ItemIndex] as TRealICQContacterTreeView;
- if RealICQFriendTreeView <> nil then
- begin
- Friend := RealICQFriendTreeView.GetEmployee(ALoginName);
- if Friend <> nil then
- Friend.StopFlash;
- end;
- end;
- end;
- end
- else
- begin
- RealICQContacterListView := GetListViewByLoginName(ALoginName);
- if RealICQContacterListView <> nil then
- begin
- ItemIndex := RealICQContacterListView.Items.IndexOf(ALoginName);
- if ItemIndex >= 0 then
- begin
- RealICQContacterListItem := RealICQContacterListView.Items.Objects[ItemIndex] as TRealICQContacterListItem;
- RealICQContacterListItem.StopFlash;
- end;
- end;
- end;
- end;
- procedure TMainForm.WMHotKeyHandle(var Msg: TWMHotKey);
- var
- iLoop: Integer;
- AForm: TTalkingForm;
- begin
- msg.Result := 1; //该消息已经处理
- if msg.HotKey = HotKeyID_ReadMessage then
- begin
- TrayIconDblClick(TrayIcon);
- end;
- if msg.HotKey = HotKeyID_CopyScreen then
- begin
- for iLoop := 0 to TalkingForms.Count - 1 do
- begin
- AForm := TalkingForms[iLoop];
- if AForm.Active then
- begin
- ShowCopyScreenForm(AForm);
- Exit;
- end;
- end;
- ShowCopyScreenForm(nil);
- end;
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.ShowRealICQMessage(RealICQMessage: TRealICQMessage; ShowSendFailed: Boolean; ARealICQClient: TRealICQClient);
- var
- LoginName: string;
- iIndex, ItemIndex: Integer;
- TalkingForm: TTalkingForm;
- MessageList: TList;
- NotReadMessage: TNotReadMessage;
- RealICQContacterListView: TRealICQContacterListView;
- RealICQContacterListItem: TRealICQContacterListItem;
- RealICQContacterTreeView: TRealICQContacterTreeView;
- Employee: TRealICQEmployee;
- RealICQFriendTreeView: TRealICQContacterTreeView;
- Friend: TRealICQEmployee;
- NeedAddToNotReadMessages: Boolean;
- begin
- try
- RealICQMessage.MessageStr := TTextMessageService.GetService.ContentFilter(RealICQMessage);
- FDBHistory.SaveMessage('-1', RealICQMessage.Sender, RealICQMessage.Receiver, RealICQMessage.SendDateTime, RealICQMessage.FontStr, RealICQMessage.MessageStr, RealICQMessage.IsEncryMessage);
- if RealICQMessage.IsEncryMessage then
- RealICQMessage.ID := FDBHistory.GetMaxMessageId;
- finally
- if AnsiSameText(RealICQMessage.Sender, ARealICQClient.LoginName) then
- LoginName := RealICQMessage.Receiver
- else
- LoginName := RealICQMessage.Sender;
- TalkingForm := GetTalkingForm(LoginName, ARealICQClient);
- if TalkingForm = nil then
- NeedAddToNotReadMessages := True
- else
- NeedAddToNotReadMessages := not TalkingForm.CanWriteMessage;
- if NeedAddToNotReadMessages then
- begin
- NotReadMessage := TNotReadMessage.Create;
- NotReadMessage.FRealICQMessage := RealICQMessage;
- NotReadMessage.FShowSendFailed := ShowSendFailed;
- NotReadMessage.FRealICQClient := ARealICQClient;
- iIndex := FNotReadMessages.IndexOf(LoginName);
- if iIndex >= 0 then
- begin
- MessageList := FNotReadMessages.Objects[iIndex] as TList;
- MessageList.Add(NotReadMessage);
- end
- else
- begin
- if MessageBoxForm = nil then
- begin
- {$region '跳动头像'}
- ItemIndex := FSearchListView.Items.IndexOf(LoginName);
- if ItemIndex >= 0 then
- begin
- RealICQContacterListItem := FSearchListView.Items.Objects[ItemIndex] as TRealICQContacterListItem;
- if FlashImageOnGetMessage then
- RealICQContacterListItem.Flash(fsJump);
- end;
- if (RealICQClient.WorkingMode = wmCorporation) or (FShowTree and TUsersService.GetUsersService.IsWorkmateOrFriend(LoginName)) then
- begin
- ItemIndex := FContacterTreeViews.IndexOf(LVMyContacters);
- RealICQContacterTreeView := FContacterTreeViews.Objects[ItemIndex] as TRealICQContacterTreeView;
- if RealICQContacterTreeView <> nil then
- begin
- Employee := RealICQContacterTreeView.GetEmployee(LoginName);
- if Employee <> nil then
- begin
- if FlashImageOnGetMessage then
- Employee.Flash(fsJump);
- end
- else
- begin
- ItemIndex := FContacterTreeViews.IndexOf(LVFriends);
- RealICQFriendTreeView := FContacterTreeViews.Objects[ItemIndex] as TRealICQContacterTreeView;
- if RealICQFriendTreeView <> nil then
- begin
- Friend := RealICQFriendTreeView.GetEmployee(LoginName);
- if Friend <> nil then
- if FlashImageOnGetMessage then
- Friend.Flash(fsJump)
- end;
- end;
- end;
- end
- else
- begin
- RealICQContacterListView := GetListViewByLoginName(LoginName);
- if RealICQContacterListView <> nil then
- begin
- ItemIndex := RealICQContacterListView.Items.IndexOf(LoginName);
- if ItemIndex >= 0 then
- begin
- RealICQContacterListItem := RealICQContacterListView.Items.Objects[ItemIndex] as TRealICQContacterListItem;
- if FlashImageOnGetMessage then
- RealICQContacterListItem.Flash(fsJump);
- end;
- end; // if RealICQContacterListView <> nil ...
- end;
- {$endregion}
- end;
- MessageList := TList.Create;
- MessageList.Add(NotReadMessage);
- FNotReadMessages.AddObject(LoginName, MessageList);
- end;
- if MessageBoxForm <> nil then
- begin
- if (GetForegroundWindow <> MessageBoxForm.Handle) then
- FlashWindow(MessageBoxForm.Handle, True);
- MessageBoxForm.ShowMessage(RealICQMessage.Sender, MTUser);
- end
- else if (not TimerForFlashTrayIcon.Enabled) then
- TimerForFlashTrayIcon.Enabled := True;
- if PlaySoundOnGetMessage then
- PlayEventSound(FMessageEventSound);
- NotReadMessageBoxForm.ShowNotReadMessage;
- NotReadMessageBoxForm.Height := 0;
- NotReadMessageBoxForm.Top := Screen.WorkAreaHeight - NotReadMessageBoxForm.Height;
- end
- else
- begin
- if (GetForegroundWindow <> TalkingForm.Handle) then
- begin
- FlashWindow(TalkingForm.Handle, True);
- if PlaySoundOnGetMessage then
- PlayEventSound(FMessageEventSound);
- end;
- TalkingForm.ShowMessage(RealICQMessage, ShowSendFailed);
- end;
- end;
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.RealICQClientSendedSendFileRequest(Sender, FileTransmitter: TObject);
- var
- PtoPFileTransmitter: TPtoPFileTransmitter;
- TalkingForm: TTalkingForm;
- ALoginName: string;
- RealICQUser: TRealICQUser;
- ItemIndex: Integer;
- RealICQContacterListItem: TRealICQContacterListItem;
- begin
- PtoPFileTransmitter := FileTransmitter as TPtoPFileTransmitter;
- if PtoPFileTransmitter.Objective = foFace then
- begin
- TalkingForm := GetTalkingForm(PtoPFileTransmitter.LoginName, Sender as TRealICQClient);
- if TalkingForm = nil then
- Exit;
- end
- else
- begin
- TalkingForm := OpenTalkingForm(PtoPFileTransmitter.LoginName, True, Sender as TRealICQClient);
- end;
- if TalkingForm.CanWriteMessage then
- TalkingForm.ShowSendedSendFileRequest(PtoPFileTransmitter);
-
- {$region '更新“最近联系人列表”中的数据'}
- if Sender = RealICQClient then
- begin
- ALoginName := PtoPFileTransmitter.LoginName;
- RealICQUser := TUsersService.GetUsersService.GetOrRequestUser(ALoginName);
- if RealICQUser <> nil then
- begin
- ItemIndex := FLVLatests.Items.IndexOf(ALoginName);
- if ItemIndex = -1 then
- ItemIndex := FLVLatests.Items.Add(ALoginName);
- RealICQContacterListItem := FLVLatests.Items.Objects[ItemIndex] as TRealICQContacterListItem;
- //BindUserDataToItem(RealICQContacterListItem, RealICQUser);
- TUsersService.GetUsersService.UpdateListItem(FLVLatests, RealICQContacterListItem, RealICQUser);
- RealICQContacterListItem.MoveToTop;
- end;
- end;
- {$endregion}
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.RealICQClientSendedTeamMessage(Sender: TObject; RealICQTeamMessage: TRealICQTeamMessage);
- begin
- ShowRealICQTeamMessage(RealICQTeamMessage, False);
- end;
- procedure TMainForm.RealICQClientCancelControlRemoteControlTransmite(Sender: TObject; ALoginName: string);
- var
- TalkingForm: TTalkingForm;
- begin
- TalkingForm := GetTalkingForm(ALoginName, Sender as TRealICQClient);
- if TalkingForm = nil then
- Exit;
- if TalkingForm.CanWriteMessage then
- TalkingForm.ShowCancelControlRemoteControlTransmite;
- end;
- procedure TMainForm.RealICQClientCanceledSendFolder(Sender: TObject; AID: Cardinal; ALoginName: string);
- var
- ReceiveFolderRequestForm: TReceiveFolderRequestForm;
- iLoop: Integer;
- begin
- for iLoop := 0 to ReceiveFolderForms.Count - 1 do
- begin
- ReceiveFolderRequestForm := TReceiveFolderRequestForm(ReceiveFolderForms[iLoop]);
- if (ReceiveFolderRequestForm.FID = AID) and AnsiSameText(ALoginName, ReceiveFolderRequestForm.FLoginName) then
- begin
- ReceiveFolderRequestForm.CanceledSendFolder;
- Break;
- end;
- end;
- end;
- procedure TMainForm.RealICQClientCancelSendFile(Sender: TObject; ALoginName: string; AOppositeID: Cardinal);
- var
- TalkingForm: TTalkingForm;
- iWaitTimes: Integer;
- begin
- TalkingForm := GetTalkingForm(ALoginName, Sender as TRealICQClient);
- if TalkingForm <> nil then
- begin
- if (GetForegroundWindow <> TalkingForm.Handle) then
- begin
- FlashWindow(TalkingForm.Handle, True);
- if PlaySoundOnGetMessage then
- PlayEventSound(FMessageEventSound);
- end;
- iWaitTimes := 0;
- while not TalkingForm.CanWriteMessage do
- begin
- Application.ProcessMessages;
- Inc(iWaitTimes);
- if iWaitTimes > 1000 then
- break;
- Sleep(10);
- end;
- TalkingForm.ShowCancelSendFile(AOppositeID);
- end;
- end;
- procedure TMainForm.RealICQClientChangePasswordResult(Sender: TObject; APassChanged: Boolean; ANewPassword: string);
- begin
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.RealICQClientGettedSendFileRequest(Sender: TObject; SendFileRequestInfo: TSendFileRequestInfo);
- var
- AShowActive: Boolean;
- TalkingForm: TTalkingForm;
- iWaitTimes: Integer;
- ALoginName: string;
- RealICQUser: TRealICQUser;
- ItemIndex: Integer;
- RealICQContacterListItem: TRealICQContacterListItem;
- begin
- AShowActive := (RealICQClient.IsAutoState = True) and (RealICQClient.Me.LoginState = stLeave) and AnsiSameText(RealICQClient.Me.LeaveMessage, '忙碌');
- TalkingForm := GetTalkingForm(SendFileRequestInfo.LoginName, Sender as TRealICQClient);
- if TalkingForm = nil then
- begin
- TalkingForm := OpenTalkingForm(SendFileRequestInfo.LoginName, not AShowActive, Sender as TRealICQClient);
- end;
- iWaitTimes := 0;
- while not TalkingForm.CanWriteMessage do
- begin
- Application.ProcessMessages;
- Inc(iWaitTimes);
- if iWaitTimes > 1000 then
- break;
- Sleep(10);
- end;
- if (GetForegroundWindow <> TalkingForm.Handle) and (SendFileRequestInfo.Objective = foFile) then
- begin
- FlashWindow(TalkingForm.Handle, True);
- if PlaySoundOnGetMessage then
- PlayEventSound(FMessageEventSound);
- end;
- TalkingForm.ShowGettedSendFileRequest(SendFileRequestInfo);
-
- {$region '更新“最近联系人列表”中的数据'}
- if Sender = RealICQClient then
- begin
- ALoginName := SendFileRequestInfo.LoginName;
- RealICQUser := TUsersService.GetUsersService.GetOrRequestUser(ALoginName);
- if RealICQUser <> nil then
- begin
- ItemIndex := FLVLatests.Items.IndexOf(ALoginName);
- if ItemIndex = -1 then
- ItemIndex := FLVLatests.Items.Add(ALoginName);
- RealICQContacterListItem := FLVLatests.Items.Objects[ItemIndex] as TRealICQContacterListItem;
- //BindUserDataToItem(RealICQContacterListItem, RealICQUser);
- TUsersService.GetUsersService.UpdateListItem(FLVLatests, RealICQContacterListItem, RealICQUser);
- RealICQContacterListItem.MoveToTop;
- end;
- end;
- {$endregion}
- end;
- procedure TMainForm.RealICQClientGettedSendFolderRequest(Sender: TObject; AID, ACount: Cardinal; ALoginName: string; AFilesStream: TStream);
- var
- ReceiveFolderRequestForm: TReceiveFolderRequestForm;
- begin
- ReceiveFolderRequestForm := TReceiveFolderRequestForm.Create(Self);
- ReceiveFolderRequestForm.FCount := ACount;
- ReceiveFolderRequestForm.FID := AID;
- ReceiveFolderRequestForm.FLoginName := ALoginName;
- ReceiveFolderRequestForm.FFilesStream := AFilesStream;
- ReceiveFolderRequestForm.Show;
- ReceiveFolderRequestForm.BringToFront;
- end;
- procedure TMainForm.RealICQClientGettedSendOfflineFileRequest(Sender: TObject; ALoginName: string; AOppositeID: Cardinal);
- var
- TalkingForm: TTalkingForm;
- iWaitTimes: Integer;
- begin
- TalkingForm := GetTalkingForm(ALoginName, Sender as TRealICQClient);
- if TalkingForm <> nil then
- begin
- if (GetForegroundWindow <> TalkingForm.Handle) then
- begin
- FlashWindow(TalkingForm.Handle, True);
- if PlaySoundOnGetMessage then
- PlayEventSound(FMessageEventSound);
- end;
- iWaitTimes := 0;
- while not TalkingForm.CanWriteMessage do
- begin
- Application.ProcessMessages;
- Inc(iWaitTimes);
- if iWaitTimes > 1000 then
- break;
- Sleep(10);
- end;
- TalkingForm.ShowSendOfflineFileRequest(AOppositeID);
- end;
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.RealICQClientSendMessageFailed(Sender: TObject; RealICQMessage: TRealICQMessage);
- begin
- ShowRealICQMessage(RealICQMessage, True, Sender as TRealICQClient);
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.RealICQClientSendTeamMessageFailed(Sender: TObject; RealICQTeamMessage: TRealICQTeamMessage);
- begin
- ShowRealICQTeamMessage(RealICQTeamMessage, True);
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.RealICQClientShakeWindow(Sender: TObject; ALoginName: string);
- var
- TalkingForm: TTalkingForm;
- iWaitTimes: Integer;
- begin
- if not MainForm.ShowShakeWindow then
- Exit;
- TalkingForm := GetTalkingForm(ALoginName, Sender as TRealICQClient);
- if TalkingForm = nil then
- begin
- TalkingForm := OpenTalkingForm(ALoginName, True, Sender as TRealICQClient);
- end;
- iWaitTimes := 0;
- while not TalkingForm.CanWriteMessage do
- begin
- Application.ProcessMessages;
- Inc(iWaitTimes);
- if iWaitTimes > 1000 then
- break;
- Sleep(10);
- end;
- if GetTickCount - TalkingForm.LastRecvShakeWindowTicket < 150000 then
- Exit;
- ForceForeGroundWindow(TalkingForm.Handle);
- TalkingForm.ShowShakeWindow(False);
- TalkingForm.LastRecvShakeWindowTicket := GetTickCount;
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.RealICQClientSMSResult(Sender: TObject; AMessageID: Cardinal; AResult: Integer);
- var
- iIndex: Integer;
- SMSMessage: TSMSMessage;
- begin
- iIndex := SMSMessages.IndexOf(IntToStr(AMessageID));
- if iIndex >= 0 then
- begin
- SMSMessage := SMSMessages.Objects[iIndex] as TSMSMessage;
- SMSMessage.Sended := AResult = 0;
- SMSMessage.SMSForm.ShowSMSMessageResult(AMessageID, AResult);
- end;
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.RealICQClientTeamInfoReady(Sender: TObject; ARealICQTeam: TRealICQTeam);
- var
- iLoop, iIndex: Integer;
- ListItem: TRealICQContacterListItem;
- MemberList: TStringList;
- begin
- iIndex := FLVTeams.Items.IndexOf(ARealICQTeam.TeamID);
- if iIndex = -1 then
- iIndex := FLVTeams.Items.Add(ARealICQTeam.TeamID);
- ListItem := FLVTeams.Items.Objects[iIndex] as TRealICQContacterListItem;
- if ARealICQTeam.IsTempTeam then
- ListItem.Watchword := ''
- else
- ListItem.Watchword := ARealICQTeam.TeamIntro;
- ListItem.LoginState := stLeave;
- MemberList := SplitString(ARealICQTeam.TeamMembers, Chr(10));
- try
- for iLoop := MemberList.Count - 1 downto 0 do
- begin
- if Length(Trim(MemberList[iLoop])) = 0 then
- MemberList.Delete(iLoop);
- end;
- ListItem.LeaveMessage := IntToStr(MemberList.Count) + '个成员';
- finally
- MemberList.Free;
- end;
-
- {try
- ListItem.HeadImagePicture.LoadFromFile(ExtractFilePath(Application.ExeName) + TeamPicture);
- except
- ListItem.HeadImagePicture.Graphic := nil;
- end; }
- if ARealICQTeam.IsTempTeam then
- ListItem.DisplayName := '多人对话'
- else
- ListItem.DisplayName := ARealICQTeam.TeamCaption;
- ListItem.Data := ARealICQTeam;
- ListItem.ReDrawItem;
- // UpdateTeamOptionsForm(ARealICQTeam);
- UpdateTeamTalkingForm(ARealICQTeam);
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.RealICQClientReceivedAdversement(Sender: TObject);
- begin
- if (not RealICQClient.MainFormAdversement.Visible) then
- begin
- if pnlAdvertisement.Height > 0 then
- pnlAdvertisement.Height := 0;
- end
- else
- begin
- WebBrowserForAdvertisement.OnBeforeNavigate2 := nil;
- pnlForHideWebBrowser.Visible := True;
- pnlForHideWebBrowser.BringToFront;
- WebBrowserForAdvertisement.OnDocumentComplete := WebBrowserForAdvertisementDocumentComplete;
- WebBrowserForAdvertisement.Navigate(AnsiReplaceText(AnsiReplaceText(RealICQClient.MainFormAdversement.URL, '[%LoginName%]', RealICQClient.LoginName), '[%BranchID%]', RealICQClient.Me.BranchID));
- pnlWebSearch.Top := pnlAdvertisement.Top + pnlAdvertisement.Height + 1;
- end;
- UpdateTalkingFormAdversement;
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.RealICQClientReceivedCustomMessage(Sender: TObject; AContent: string);
- var
- Contents: TStringList;
- LoginName: string;
- SystemMessage: TRealICQSystemMessage;
- jo: ISuperObject;
- reg: TPerlRegEx;
- begin
- if AnsiSameText('ReGetCountByReceiver', AContent) then
- begin
- RealICQClient.SendGetNewInformation(0);
- Exit;
- end;
- if AnsiSameText('ReGetAnnouncement', AContent) then
- begin
- RealICQClient.SendGetNewInformation(1);
- Exit;
- end;
- AContent := AnsiReplaceStr(AContent, Chr(13), '');
- Contents := RealICQUtils.SplitString(AContent, Chr(10));
- try
- //TODO: lqq 新消息通知接口
- if (Contents.Count > 1) and (CompareText(Contents[0], 'SendNotify') = 0) then
- begin
- jo := SO(Contents[1]);
- SystemMessage := TRealICQSystemMessage.Create;
- SystemMessage.MessageID := GetTickCount;
- Sleep(100);
- SystemMessage.MessageType := mtBroadcast;
- SystemMessage.AutoOpenWindow := True;
- SystemMessage.Position := mpRightBottom;
- SystemMessage.Left := 0;
- SystemMessage.Top := 0;
- SystemMessage.Width := 258;
- SystemMessage.Height := 168;
- SystemMessage.Delay := 0;
- SystemMessage.MaxShowTimes := 0;
- SystemMessage.Title := jo.S['title'];
- SystemMessage.URL := jo.S['url'];
- if jo.S['appkey'] = '' then
- SystemMessage.Content := Format('<p style="line-height:18px; text-indent:2em;"><a target="_blank" href="%s" style="text-decoration: none; color=#000;">%s</a></p>', [SystemMessage.URL, jo.S['content']])
- else
- SystemMessage.Content := Format('<p style="line-height:18px; text-indent:2em;"><a href="%s" style="text-decoration: none; color:#000;">%s</a></p>', ['SSO||' + jo.S['appkey'] + '||' + SystemMessage.URL, jo.S['content']]);
- SystemMessage.AutoCloseTime := 0;
- RealICQClientReceivedSystemMessage(RealICQClient, SystemMessage);
- Exit;
- end;
- if Contents.Count >= 3 then
- begin
- { if AnsiSameText(Contents.Strings[0], 'CONFIRMDLG') then
- begin
- SystemMessage := TRealICQSystemMessage.Create;
- SystemMessage.MessageID :=StrToInt(Contents.Strings[5]);// GetTickCount;
- Sleep(100);
- SystemMessage.MessageType := mtConfirmMsg;
- SystemMessage.AutoOpenWindow := True;
- SystemMessage.Position := mpCenter;
- SystemMessage.Width := 278;
- SystemMessage.Height := 178;
- SystemMessage.Delay := 0;
- SystemMessage.MaxShowTimes := 0;
- SystemMessage.Content := Contents.Strings[2];
- SystemMessage.Title := Contents.Strings[3];
- SystemMessage.URL := Contents.Strings[4]+Chr(10)+Contents.Strings[6]+Chr(10)+Contents.Strings[7];
- SystemMessage.AutoCloseTime :=120;
- RealICQClientReceivedSystemMessage(RealICQClient, SystemMessage);
- end; }
- if AnsiSameText(Contents.Strings[0], 'RJOA') or AnsiSameText(Contents.Strings[0], 'RDOA') or AnsiSameText(Contents.Strings[0], 'CONFIRM_NOTIFY') then
- begin
- SystemMessage := TRealICQSystemMessage.Create;
- SystemMessage.MessageID := GetTickCount;
- Sleep(100);
- SystemMessage.MessageType := mtBroadcast;
- if AnsiSameText(Contents.Strings[0], 'CONFIRM_NOTIFY') then
- SystemMessage.MessageType := mtAdvertisement;
- SystemMessage.AutoOpenWindow := True;
- SystemMessage.Position := mpRightBottom;
- SystemMessage.Left := 0;
- SystemMessage.Top := 0;
- SystemMessage.Width := 258;
- SystemMessage.Height := 168;
- SystemMessage.Delay := 0;
- SystemMessage.MaxShowTimes := 0;
- SystemMessage.Title := '系统提醒';
- reg := TPerlRegEx.Create;
- try
- reg.Subject := Contents.Strings[2];
- reg.RegEx := '<[^>]+>';
- reg.Replacement := '';
- while reg.MatchAgain do
- begin
- if (Length(reg.Groups[0]) >= 3) and ((SameText(LeftStr(reg.Groups[0], 3), '<a ')) or (SameText(LeftStr(reg.Groups[0], 3), '<a>'))) then
- Continue;
- if (SameText(reg.Groups[0], '</a>')) then
- Continue;
- reg.Replace();
- end;
- SystemMessage.Content := '<p style="line-height:18px; text-indent:2em;">' + reg.Subject + '</p>';
- finally
- reg.Free;
- end;
- SystemMessage.URL := '';
- SystemMessage.AutoCloseTime := 0;
- if AnsiSameText(Contents.Strings[0], 'RDOA') or AnsiSameText(Contents.Strings[0], 'CONFIRM_NOTIFY') then
- begin
- SystemMessage.URL := Contents.Strings[4];
- if Contents.Strings[6] = '1' then
- begin
- LoginName := RealICQClient.LoginName;
- if Pos('-', RealICQClient.LoginName) > 0 then
- LoginName := Copy(RealICQClient.LoginName, Pos('-', RealICQClient.LoginName) + 1, Length(RealICQClient.LoginName));
- SystemMessage.URL := SystemMessage.URL + Contents.Strings[5];
- end;
- SystemMessage.Title := Contents.Strings[7];
- end
- else
- begin
- if Contents.Count >= 7 then
- SystemMessage.URL := Contents.Strings[3];
- try
- if Contents.Count >= 5 then
- SystemMessage.Width := StrToInt(Contents.Strings[4]);
- if Contents.Count >= 6 then
- SystemMessage.Height := StrToInt(Contents.Strings[5]);
- if Contents.Count >= 7 then
- begin
- if Contents.Strings[6] = '1' then
- begin
- TimerForShowSystemNotices.Enabled := False;
- RealICQClient.SendGetNewInformation(1);
- end
- else
- begin
- RealICQClient.SendGetNewInformation(0);
- end;
- end
- else
- begin
- RealICQClient.SendGetNewInformation(0);
- end;
- if Contents.Count >= 8 then
- SystemMessage.Title := Contents.Strings[7];
- except
- end;
- end;
- RealICQClientReceivedSystemMessage(RealICQClient, SystemMessage);
- end;
- if AnsiSameText(Contents.Strings[0], 'LXUMC') then
- begin
- // if not MainForm.ShowFileTransCompleted then Exit;
- SystemMessage := TRealICQSystemMessage.Create;
- SystemMessage.MessageID := GetTickCount;
- SystemMessage.MessageType := mtBroadcast;
- SystemMessage.AutoOpenWindow := True;
- SystemMessage.Position := mpRightBottom;
- SystemMessage.Left := 0;
- SystemMessage.Top := 0;
- SystemMessage.Width := 258;
- SystemMessage.Height := 148;
- SystemMessage.Delay := 0;
- SystemMessage.MaxShowTimes := 0;
- SystemMessage.Title := '系统提醒';
- SystemMessage.Content := Contents.Strings[2];
- SystemMessage.URL := '';
- SystemMessage.AutoCloseTime := 0;
- if Contents.Count > 3 then
- SystemMessage.Title := Contents.Strings[3];
- RealICQClientReceivedSystemMessage(RealICQClient, SystemMessage);
- end;
- if AnsiSameText(Contents.Strings[0], 'EMAIL') then
- begin
- if AnsiSameText(Contents.Strings[1], '0') then
- begin
- spbEmail.Caption := '(' + Contents.Strings[2] + ')';
- end
- else if AnsiSameText(Contents.Strings[1], '1') then
- begin
- spbEmail.Caption := '(' + IntToStr(StrToInt(ReplaceStr(ReplaceStr(spbEmail.Caption, '(', ''), ')', '')) + 1) + ')';
- SystemMessage := TRealICQSystemMessage.Create;
- SystemMessage.MessageID := GetTickCount;
- SystemMessage.MessageType := mtBroadcast;
- SystemMessage.AutoOpenWindow := True;
- SystemMessage.Position := mpRightBottom;
- SystemMessage.Left := 0;
- SystemMessage.Top := 0;
- SystemMessage.Width := 258;
- SystemMessage.Height := 148;
- SystemMessage.Delay := 0;
- SystemMessage.MaxShowTimes := 0;
- SystemMessage.Title := '系统提醒';
- if AnsiSameText(Copy(Contents.Strings[3], 1, 7), 'http://') then
- begin
- SystemMessage.Content := '您从 <a herf="' + Contents.Strings[3] + '">' + Contents.Strings[2] + '</a> 处收到一封新邮件!';
- SystemMessage.URL := Contents.Strings[3];
- end
- else
- begin
- SystemMessage.Content := '您从 ' + Contents.Strings[3] + ' 处收到一封新邮件!';
- SystemMessage.URL := '';
- end;
- SystemMessage.AutoCloseTime := 15;
- RealICQClientReceivedSystemMessage(RealICQClient, SystemMessage);
- end;
- end;
- end;
- finally
- FreeAndNil(Contents);
- end;
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.RealICQClientReceivedMessage(Sender: TObject; RealICQMessage: TRealICQMessage);
- var
- ItemIndex: Integer;
- RealICQContacterListItem: TRealICQContacterListItem;
- RealICQUser: TRealICQUser;
- ALoginName: string;
- begin
- ShowRealICQMessage(RealICQMessage, False, Sender as TRealICQClient);
- {$region '更新“最近联系人列表”中的数据'}
- if Sender = RealICQClient then
- begin
- if not AnsiSameText(RealICQMessage.Sender, RealICQClient.LoginName) then
- ALoginName := RealICQMessage.Sender
- else
- ALoginName := RealICQMessage.Receiver;
- RealICQUser := TUsersService.GetUsersService.GetOrRequestUser(ALoginName);
- if RealICQUser <> nil then
- begin
- ItemIndex := FLVLatests.Items.IndexOf(ALoginName);
- if ItemIndex = -1 then
- ItemIndex := FLVLatests.Items.Add(ALoginName);
- RealICQContacterListItem := FLVLatests.Items.Objects[ItemIndex] as TRealICQContacterListItem;
- //BindUserDataToItem(RealICQContacterListItem, RealICQUser);
- TUsersService.GetUsersService.UpdateListItem(FLVLatests, RealICQContacterListItem, RealICQUser);
- RealICQContacterListItem.MoveToTop;
- end;
- end;
- {$endregion}
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.RealICQClientReceivedOfflineAutoResponseSet(Sender: TObject; AEnabled: Boolean; AText: string);
- begin
- actOfflieAutoResponse.Checked := AEnabled;
- if OptionsForm <> nil then
- OptionsForm.GetSets;
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.RealICQClientReceivedOfflineFile(Sender: TObject; ASender, AFileName: string; AFileSize: Int64; ASendDateTime: TDateTime);
- var
- AShowActive: Boolean;
- TalkingForm: TTalkingForm;
- iWaitTimes: Integer;
- ALoginName: string;
- RealICQUser: TRealICQUser;
- ItemIndex: Integer;
- RealICQContacterListItem: TRealICQContacterListItem;
- begin
- if AnsiSameText(ASender, RealICQClient.Me.LoginName) then
- Exit;
- AShowActive := (RealICQClient.IsAutoState = True) and (RealICQClient.Me.LoginState = stBusy) and AnsiSameText(RealICQClient.Me.LeaveMessage, '忙碌');
- TalkingForm := GetTalkingForm(ASender, RealICQClient);
- if TalkingForm = nil then
- begin
- TalkingForm := OpenTalkingForm(ASender, not AShowActive, RealICQClient);
- end;
- iWaitTimes := 0;
- while not TalkingForm.CanWriteMessage do
- begin
- Application.ProcessMessages;
- Inc(iWaitTimes);
- if iWaitTimes > 1000 then
- break;
- Sleep(10);
- end;
- if (GetForegroundWindow <> TalkingForm.Handle) then
- begin
- FlashWindow(TalkingForm.Handle, True);
- if PlaySoundOnGetMessage then
- PlayEventSound(FMessageEventSound);
- end;
- TFileTransmitAdapter.Receive(TalkingForm, AFileName, 0, ASender, '', ASendDateTime, Self.RealICQClient, AFileSize);
- {$region '更新“最近联系人列表”中的数据'}
- if Sender = RealICQClient then
- begin
- ALoginName := ASender;
- RealICQUser := TUsersService.GetUsersService.GetOrRequestUser(ALoginName);
- if RealICQUser <> nil then
- begin
- ItemIndex := FLVLatests.Items.IndexOf(ALoginName);
- if ItemIndex = -1 then
- ItemIndex := FLVLatests.Items.Add(ALoginName);
- RealICQContacterListItem := FLVLatests.Items.Objects[ItemIndex] as TRealICQContacterListItem;
- //BindUserDataToItem(RealICQContacterListItem, RealICQUser);
- TUsersService.GetUsersService.UpdateListItem(FLVLatests, RealICQContacterListItem, RealICQUser);
- RealICQContacterListItem.MoveToTop;
- end;
- end;
- {$endregion}
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.RealICQClientReceivedServerList(Sender: TObject; AServerList: string);
- var
- ServerList: TStringList;
- iLoop, chrPos: Integer;
- MenuItem: TMenuItem;
- ServerInfo: TServerInfo;
- //config: TConditionConfig;
- begin
- //config := TConditionConfig.GetConfig;
- while ppServerList.Items.Count > 0 do
- ppServerList.Items.Delete(0);
- ServerList := SplitString(AServerList, Chr(10));
- try
- iLoop := 0;
- while iLoop < ServerList.Count - 1 do
- begin
- ServerInfo := TServerInfo.Create;
- ServerInfo.ServerId := ServerList[iLoop];
- Inc(iLoop);
- ServerInfo.ServerName := ServerList[iLoop];
- Inc(iLoop);
- // if config.OtherServersDisable and not (UpperCase(ServerInfo.ServerId) = UpperCase(RealICQClient.ServerID)) then
- // begin
- // Continue;
- // end;
- MenuItem := TMenuItem.Create(ppServerList);
- MenuItem.AutoHotkeys := maManual;
- MenuItem.AutoLineReduction := maManual;
- MenuItem.Caption := '&' + ServerInfo.ServerName;
- MenuItem.Hint := ServerInfo.ServerId;
- MenuItem.OnClick := miChangeServerClick;
- MenuItem.Tag := iLoop;
- if UpperCase(ServerInfo.ServerId) = UpperCase(RealICQClient.ServerID) then
- begin
- edServerList.Text := ServerInfo.ServerName;
- ImgLoadingMoreBranchs.Visible := True;
- ScrollBoxMoreUser.Visible := False;
- //RealICQClient.SendGetMoreBranch(ServerInfo.ServerId);
- RealICQClient.SendGetBranchs(ServerInfo.ServerId, 0);
- FCurrentServerID := ServerInfo.ServerId;
- //Todo: 调用Online.exe
- if FileExists(ExtractFilePath(Application.ExeName) + 'Online.exe') then
- TCheckRunProcessThread.Create('Online', ExtractFilePath(Application.ExeName) + 'Online.exe')
- //else
- //Self.PostUpdateLog;
- end;
- FServerInfoList.AddObject(ServerInfo.ServerId, ServerInfo);
- ppServerList.Items.Add(MenuItem);
- end;
- finally
- FreeAndNil(ServerList);
- end;
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.ShowRealICQTeamMessage(RealICQTeamMessage: TRealICQTeamMessage; ShowSendFailed: Boolean);
- var
- nTeamID: string;
- iIndex, ItemIndex: Integer;
- MessageList: TList;
- TalkingForm: TTalkingForm;
- NotReadTeamMessage: TNotReadTeamMessage;
- NeedAddToNotReadMessages: Boolean;
- ListItem: TRealICQContacterListItem;
- ASave: Boolean;
- begin
- try
- ASave := AutoSaveMessage;
- if Copy(RealICQTeamMessage.MessageStr, 1, 11) = '<TeamShare>' then
- begin
- if Copy(RealICQTeamMessage.MessageStr, Length(RealICQTeamMessage.MessageStr) - 11, 12) = '</TeamShare>' then
- begin
- ASave := False;
- end;
- end;
- if ASave then
- begin
- FDBHistory.SaveMessage(RealICQTeamMessage.TeamID, RealICQTeamMessage.Sender, RealICQClient.LoginName, RealICQTeamMessage.SendDateTime, RealICQTeamMessage.FontStr, RealICQTeamMessage.MessageStr, RealICQTeamMessage.IsEncryMessage);
- if RealICQTeamMessage.IsEncryMessage then
- RealICQTeamMessage.ID := FDBHistory.GetMaxMessageId;
- end;
- except
- end;
- nTeamID := RealICQTeamMessage.TeamID;
- TalkingForm := GetTeamTalkingForm(nTeamID);
- if TalkingForm = nil then
- NeedAddToNotReadMessages := True
- else
- NeedAddToNotReadMessages := not TalkingForm.CanWriteMessage;
- if NeedAddToNotReadMessages then
- begin
- NotReadTeamMessage := TNotReadTeamMessage.Create;
- NotReadTeamMessage.FRealICQTeamMessage := RealICQTeamMessage;
- NotReadTeamMessage.FShowSendFailed := ShowSendFailed;
- iIndex := FNotReadMessages.IndexOf(TeamMessageID + nTeamID);
- if iIndex >= 0 then
- begin
- MessageList := FNotReadMessages.Objects[iIndex] as TList;
- MessageList.Add(NotReadTeamMessage);
- end
- else
- begin
- {$region '跳动头像'}
- ItemIndex := FLVTeams.Items.IndexOf(nTeamID);
- if ItemIndex >= 0 then
- begin
- ListItem := FLVTeams.Items.Objects[ItemIndex] as TRealICQContacterListItem;
- if FlashImageOnGetMessage then
- ListItem.Flash(fsJump);
- end;
- {$endregion}
- MessageList := TList.Create;
- MessageList.Add(NotReadTeamMessage);
- FNotReadMessages.AddObject(TeamMessageID + nTeamID, MessageList);
- TimerForFlashTrayIcon.Enabled := True;
- if PlaySoundOnGetMessage then
- PlayEventSound(FMessageEventSound);
- end;
- if MessageBoxForm <> nil then
- begin
- if (GetForegroundWindow <> MessageBoxForm.Handle) then
- FlashWindow(MessageBoxForm.Handle, True);
- MessageBoxForm.ShowMessage(RealICQTeamMessage.Sender, MTTeam);
- Exit;
- end
- else if (not TimerForFlashTrayIcon.Enabled) then
- TimerForFlashTrayIcon.Enabled := True;
- NotReadMessageBoxForm.ShowNotReadMessage;
- NotReadMessageBoxForm.Height := 0;
- NotReadMessageBoxForm.Top := Screen.WorkAreaHeight - NotReadMessageBoxForm.Height;
- end
- else
- begin
- if (GetForegroundWindow <> TalkingForm.Handle) then
- begin
- FlashWindow(TalkingForm.Handle, True);
- if PlaySoundOnGetMessage then
- PlayEventSound(FMessageEventSound);
- end;
- TalkingForm.ShowTeamMessage(RealICQTeamMessage, ShowSendFailed);
- end;
- end;
- procedure TMainForm.RealICQClientReceivedSMS(Sender: TObject; ASMSSender, ASMSContent: string; ASMSDateTime: TDateTime);
- var
- NotReadSMSMessage: TNotReadSMSMessage;
- SMSForm: TSMSForm;
- ASender: string;
- iLoop: Integer;
- ARealICQUser: TRealICQUser;
- NeedAddToNotReadMessages: Boolean;
- MessageList: TList;
- iIndex: Integer;
- AUsers: TStringList;
- begin
- ASender := '';
- AUsers := TUsersService.GetUsersService.GetWorkmatesAndFriends;
- try
- for iLoop := 0 to AUsers.Count - 1 do
- begin
- ARealICQUser := AUsers.Objects[iLoop] as TRealICQUser;
- if Length(Trim(ARealICQUser.Mobile)) < 11 then
- continue;
- if Pos(ARealICQUser.Mobile, ASMSSender) > 0 then
- begin
- ASender := ARealICQUser.LoginName;
- Break;
- end;
- if Length(ARealICQUser.Mobile) < 10 then
- begin
- if AnsiSameStr('1060578' + ARealICQUser.Mobile, ASMSSender) then
- begin
- ASender := ARealICQUser.LoginName;
- Break;
- end;
- end;
- end;
- // if ASender = '' then
- // ASender := ASMSSender;
- finally
- FreeAndNil(AUsers);
- end;
- SMSForm := GetSMSForm(ASender);
- NotReadSMSMessage := TNotReadSMSMessage.Create;
- NotReadSMSMessage.FSMSSender := ASMSSender;
- NotReadSMSMessage.FSMSContent := ASMSContent;
- NotReadSMSMessage.FSMSDateTime := ASMSDateTime;
- iIndex := FNotReadMessages.IndexOf(SMSMessageID + ASender);
- if iIndex >= 0 then
- begin
- MessageList := FNotReadMessages.Objects[iIndex] as TList;
- MessageList.Add(NotReadSMSMessage);
- end
- else
- begin
- MessageList := TList.Create;
- MessageList.Add(NotReadSMSMessage);
- FNotReadMessages.AddObject(SMSMessageID + ASender, MessageList);
- TimerForFlashTrayIcon.Enabled := True;
- if PlaySoundOnGetMessage then
- PlayEventSound(FMessageEventSound);
- end;
- if SMSForm = nil then
- NeedAddToNotReadMessages := True
- else
- NeedAddToNotReadMessages := not SMSForm.CanWriteMessage;
- if NeedAddToNotReadMessages then
- begin
- TimerForFlashTrayIcon.Enabled := True;
- if PlaySoundOnGetMessage then
- PlayEventSound(FMessageEventSound);
- if MessageBoxForm <> nil then
- begin
- if (GetForegroundWindow <> MessageBoxForm.Handle) then
- FlashWindow(MessageBoxForm.Handle, True);
- MessageBoxForm.ShowMessage(ASender, MTSMS);
- Exit;
- end
- else if (not TimerForFlashTrayIcon.Enabled) then
- TimerForFlashTrayIcon.Enabled := True;
- NotReadMessageBoxForm.ShowNotReadMessage;
- NotReadMessageBoxForm.Height := 0;
- NotReadMessageBoxForm.Top := Screen.WorkAreaHeight - NotReadMessageBoxForm.Height;
- end
- else
- begin
- if (GetForegroundWindow <> SMSForm.Handle) then
- begin
- FlashWindow(SMSForm.Handle, True);
- if PlaySoundOnGetMessage then
- PlayEventSound(FMessageEventSound);
- end;
- //显示收到的短消息
- SMSForm.LoadNotReadSMSMessages;
- end;
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.RealICQClientReceivedSystemMessage(Sender: TObject; ASystemMessage: TRealICQSystemMessage);
- begin
- if (ASystemMessage.MaxShowTimes = 0) or ((GetSystemMessageCounter(ASystemMessage.MessageID) < ASystemMessage.MaxShowTimes) and (ASystemMessage.MaxShowTimes > 0)) then
- begin
- try
- FDBHistory.SaveSystemMessage(ASystemMessage.MessageID, ASystemMessage.MessageType, ASystemMessage.Position, ASystemMessage.Left, ASystemMessage.Top, ASystemMessage.Width, ASystemMessage.Height, ASystemMessage.Title, ASystemMessage.Content, ASystemMessage.URL, ASystemMessage.AutoCloseTime);
- except
- end;
- FSystemMessages.Insert(0, ASystemMessage);
- if TimerForShowSystemMessage.Enabled = False then
- TimerForShowSystemMessage.Enabled := True;
- end;
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.ShowSystemMessage(ASystemMessage: TRealICQSystemMessage);
- begin
- try
- OpenSystemMessageForm(IntToStr(ASystemMessage.MessageID), ASystemMessage.MessageType, ASystemMessage.Position, ASystemMessage.Left, ASystemMessage.Top, ASystemMessage.Width, ASystemMessage.Height, ASystemMessage.Title, ASystemMessage.Content, ASystemMessage.URL, ASystemMessage.AutoCloseTime);
- IncSystemMessageCounter(ASystemMessage.MessageID);
- finally
- FreeAndNil(ASystemMessage);
- end;
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.TimerForShowSystemMessageTimer(Sender: TObject);
- var
- iLoop: Integer;
- ASystemMessage: TRealICQSystemMessage;
- begin
- if FSystemMessages.Count = 0 then
- TimerForShowSystemMessage.Enabled := False
- else
- begin
- for iLoop := FSystemMessages.Count - 1 downto 0 do
- begin
- ASystemMessage := FSystemMessages[iLoop];
- ASystemMessage.Delay := ASystemMessage.Delay - 0.2;
- if ASystemMessage.Delay <= 0 then
- begin
- FSystemMessages.Delete(iLoop);
- if ASystemMessage.AutoOpenWindow then
- begin
- ShowSystemMessage(ASystemMessage);
- end
- else
- begin
- FNotReadMessages.AddObject(SystemMessageID + IntToStr(ASystemMessage.MessageID), ASystemMessage);
- TimerForFlashTrayIcon.Enabled := True;
- if PlaySoundOnGetSystemMessage then
- PlayEventSound(FSystemMessageEventSound);
- NotReadMessageBoxForm.ShowNotReadMessage;
- NotReadMessageBoxForm.Height := 0;
- NotReadMessageBoxForm.Top := Screen.WorkAreaHeight - NotReadMessageBoxForm.Height;
- end;
- end;
- end;
- if (self.MessageBoxForm <> nil) then
- MessageBoxForm.ShowSystemMessages(FSystemMessages);
- end;
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.RealICQClientReceivedTeamMessage(Sender: TObject; RealICQTeamMessage: TRealICQTeamMessage);
- begin
- ShowRealICQTeamMessage(RealICQTeamMessage, False);
- end;
- procedure TMainForm.RealICQClientReceivedVideoImage(Sender: TObject; ALoginName: string; ABitmap: TBitmap);
- begin
- end;
- {
- //------------------------------------------------------------------------------
- procedure TMainForm.UpdateFriendNode(Friend: TRealICQEmployee; RealICQUser: TRealICQUser; ANeedFlash: Boolean);
- var
- GIFImage: TGIFImage;
- jo: IsuperObject;
- ARemarkTel, ARemarkMobile, ARemark: string;
- begin
- jo := TUserRemarkService.GetService.GetUserRemark(RealICQUser.LoginName);
- if jo <> nil then
- begin
- ARemark := jo.S['Remark'];
- ARemarkTel := jo.S['Phone'];
- ARemarkMobile := jo.S['Mobile'];
- end;
- Friend.HasCamera := RealICQUser.InstalledCamera;
- Friend.Watchword := RealICQUser.Watchword;
- Friend.LeaveMessage := RealICQUser.LeaveMessage;
- Friend.HasTelephone := (Length(Trim(ARemarkTel)) > 0) or (Length(Trim(RealICQUser.Tel)) > 0) or (Length(Trim(RealICQUser.Mobile)) > 0);
- Friend.TelephoneHint := '';
- if Length(Trim(ARemarkTel)) > 0 then
- begin
- Friend.TelephoneHint := Friend.TelephoneHint + '备注:' + Trim(ARemarkTel);
- end;
- if Length(Trim(RealICQUser.Tel)) > 0 then
- begin
- if Length(Trim(Friend.TelephoneHint)) > 0 then
- Friend.TelephoneHint := Friend.TelephoneHint + ' ';
- Friend.TelephoneHint := Friend.TelephoneHint + '电话:' + Trim(RealICQUser.Tel);
- end;
- if Length(Trim(RealICQUser.Mobile)) > 0 then
- begin
- if Length(Trim(Friend.TelephoneHint)) > 0 then
- Friend.TelephoneHint := Friend.TelephoneHint + ' ';
- Friend.TelephoneHint := Friend.TelephoneHint + '手机:' + Trim(RealICQUser.Mobile);
- end;
- Friend.HasMobilePhone := False;
- Friend.HasEmail := (Length(Trim(RealICQUser.Email)) > 0);
- Friend.HasSMS := (Length(Trim(RealICQUser.Mobile)) > 0);
- if not Friend.HasTelephone then
- Friend.HasTelephone := Friend.HasSMS;
- Friend.Mobile := Trim(RealICQUser.Mobile);
- Friend.Tel := Trim(RealICQUser.Tel);
- if Length(Trim(ARemarkMobile)) > 0 then
- Friend.MobilePhoneHint := Trim(ARemarkMobile)
- else
- Friend.MobilePhoneHint := Trim(RealICQUser.Mobile);
- Friend.HeadImageHint := '单击显示联系人卡片';
- Friend.TelephoneHint := Friend.TelephoneHint;
- Friend.EmailHint := Trim(RealICQUser.Email) + '(双击发送邮件)';
- Friend.SMSHint := Trim(Friend.MobilePhoneHint) + '(双击发送手机短信息)';
- Friend.CameraHint := '双击发送视频对话邀请';
- if (RealICQClient.EnableSecretLevel) and (RealICQUser.Secret = slAllCannotSee) then
- begin
- Friend.TelephoneHint := '*';
- Friend.MobilePhoneHint := '*';
- Friend.SMSHint := '*';
- end;
- if FileExists(RealICQUser.HeadImageFile) then
- begin
- try
- if (RealICQUser.HeadImageFileType = htGIF) then
- begin
- GIFImage := TGIFImage.Create;
- GIFImage.Animate := False;
- try
- GIFImage.LoadFromFile(RealICQUser.HeadImageFile);
- Friend.HeadImagePicture.Bitmap.Assign(GIFImage);
- finally
- GIFImage.Free;
- end;
- end
- else
- Friend.HeadImagePicture.LoadFromFile(RealICQUser.HeadImageFile);
- except
- Friend.HeadImagePicture.Graphic := nil;
- end;
- end
- else
- Friend.HeadImagePicture.Graphic := nil;
- Friend.DisplayName := RealICQUser.DisplayName;
- Friend.LoginState := RealICQUser.LoginState;
- Friend.Data := RealICQUser;
- if ANeedFlash then
- Friend.Update;
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.UpdateEmployeeNode(Employee: TRealICQEmployee; RealICQUser: TRealICQUser; ANeedFlash: Boolean);
- var
- GIFImage: TGIFImage;
- jo: ISuperObject;
- ARemarkTel, ARemarkMobile, ARemark: string;
- begin
- jo := TUserRemarkService.GetService.GetUserRemark(RealICQUser.LoginName);
- if jo <> nil then
- begin
- ARemark := jo.S['Remark'];
- ARemarkTel := jo.S['Phone'];
- ARemarkMobile := jo.S['Mobile'];
- end;
- Employee.HasCamera := RealICQUser.InstalledCamera;
- Employee.Watchword := RealICQUser.Watchword;
- Employee.LeaveMessage := RealICQUser.LeaveMessage;
- Employee.HasNewSNS := ShowSNS and RealICQUser.HasNewSNSUpdate;
- Employee.NewSNSHint := '个人空间最近有更新，点击查看';
- Employee.HasTelephone := (Length(Trim(ARemarkTel)) > 0) or (Length(Trim(ARemarkTel)) > 0) or (Length(Trim(RealICQUser.Mobile)) > 0);
- Employee.TelephoneHint := '';
- if Length(Trim(ARemarkTel)) > 0 then
- begin
- Employee.TelephoneHint := Employee.TelephoneHint + '备注:' + Trim(ARemarkTel);
- end;
- if Length(Trim(RealICQUser.Tel)) > 0 then
- begin
- if Length(Trim(Employee.TelephoneHint)) > 0 then
- Employee.TelephoneHint := Employee.TelephoneHint + ' ';
- Employee.TelephoneHint := Employee.TelephoneHint + '电话:' + Trim(RealICQUser.Tel);
- end;
- if Length(Trim(RealICQUser.Mobile)) > 0 then
- begin
- if Length(Trim(Employee.TelephoneHint)) > 0 then
- Employee.TelephoneHint := Employee.TelephoneHint + ' ';
- Employee.TelephoneHint := Employee.TelephoneHint + '手机:' + Trim(RealICQUser.Mobile);
- end;
- Employee.HasMobilePhone := False;
- Employee.HasSMS := (Length(Trim(RealICQUser.Mobile)) > 0);
- Employee.Tel := Trim(RealICQUser.Tel);
- Employee.Mobile := Trim(RealICQUser.Mobile);
- if Length(Trim(ARemarkMobile)) > 0 then
- Employee.MobilePhoneHint := Trim(ARemarkMobile)
- else
- Employee.MobilePhoneHint := Trim(RealICQUser.Mobile);
- Employee.HeadImageHint := '单击显示联系人卡片';
- Employee.TelephoneHint := Trim(Employee.TelephoneHint);
- Employee.AddFriendHint := '双击添加好友';
- Employee.EmailHint := Trim(RealICQUser.Email) + '(双击发送邮件)';
- Employee.SMSHint := Employee.MobilePhoneHint + '(双击发送手机短信息)';
- Employee.CameraHint := '双击发送视频对话邀请';
- if (RealICQClient.EnableSecretLevel) and (RealICQUser.Secret = slAllCannotSee) and (Employee.LoginName <> MainForm.RealICQClient.Me.LoginName) then
- begin
- Employee.TelephoneHint := '*';
- Employee.MobilePhoneHint := '*';
- Employee.SMSHint := '*';
- end;
- if (RealICQClient.EnableSecretLevel) and (RealICQUser.Secret = slOnlyFriendCanSee) and not (TUsersService.GetUsersService.IsWorkmateOrFriend(Employee.LoginName)) then
- begin
- Employee.TelephoneHint := '*';
- Employee.MobilePhoneHint := '*';
- Employee.SMSHint := '*';
- end;
- if FileExists(RealICQUser.HeadImageFile) then
- begin
- try
- if (RealICQUser.HeadImageFileType = htGIF) then
- begin
- GIFImage := TGIFImage.Create;
- GIFImage.Animate := False;
- try
- GIFImage.LoadFromFile(RealICQUser.HeadImageFile);
- Employee.HeadImagePicture.Bitmap.Assign(GIFImage);
- finally
- GIFImage.Free;
- end;
- end
- else
- Employee.HeadImagePicture.LoadFromFile(RealICQUser.HeadImageFile);
- except
- Employee.HeadImagePicture.Graphic := nil;
- end;
- end
- else
- Employee.HeadImagePicture.Graphic := nil;
- Employee.DisplayName := RealICQUser.DisplayName;
- Employee.LoginState := RealICQUser.LoginState;
- Employee.Data := RealICQUser;
- if (FMeUserType = lbutCompany) and (TLBUserViewService.GetService.GetUserType(RealICQUser.LoginName) = lbutCompany) then
- begin
- Employee.TelephoneHint := '*';
- Employee.MobilePhoneHint := '*';
- Employee.SMSHint := '*';
- end;
- if ANeedFlash then
- Employee.Update;
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.BindUserDataToItem(RealICQContacterListItem: TRealICQContacterListItem; RealICQUser: TRealICQUser; ANeedFlash: Boolean = True);
- var
- GIFImage: TGIFImage;
- jo: ISuperObject;
- ARemarkTel, ARemarkMobile, ARemark: string;
- begin
- jo := TUserRemarkService.GetService.GetUserRemark(RealICQUser.LoginName);
- if jo <> nil then
- begin
- ARemark := jo.S['Remark'];
- ARemarkTel := jo.S['Phone'];
- ARemarkMobile := jo.S['Mobile'];
- end;
- RealICQContacterListItem.HasCamera := RealICQUser.InstalledCamera;
- RealICQContacterListItem.Watchword := RealICQUser.Watchword;
- RealICQContacterListItem.LeaveMessage := RealICQUser.LeaveMessage;
- RealICQContacterListItem.Branch := RealICQUser.Branch;
- RealICQContacterListItem.HasTelephone := (Length(Trim(ARemarkTel)) > 0) or (Length(Trim(RealICQUser.Tel)) > 0) or (Length(Trim(RealICQUser.Mobile)) > 0);
- RealICQContacterListItem.TelephoneHint := '';
- if Length(Trim(ARemarkTel)) > 0 then
- begin
- RealICQContacterListItem.TelephoneHint := RealICQContacterListItem.TelephoneHint + '备注:' + Trim(ARemarkTel);
- end;
- if Length(Trim(RealICQUser.Tel)) > 0 then
- begin
- if Length(Trim(RealICQContacterListItem.TelephoneHint)) > 0 then
- RealICQContacterListItem.TelephoneHint := RealICQContacterListItem.TelephoneHint + ' ';
- RealICQContacterListItem.TelephoneHint := RealICQContacterListItem.TelephoneHint + '电话:' + Trim(RealICQUser.Tel);
- end;
- if Length(Trim(RealICQUser.Mobile)) > 0 then
- begin
- if Length(Trim(RealICQContacterListItem.TelephoneHint)) > 0 then
- RealICQContacterListItem.TelephoneHint := RealICQContacterListItem.TelephoneHint + ' ';
- RealICQContacterListItem.TelephoneHint := RealICQContacterListItem.TelephoneHint + '手机:' + Trim(RealICQUser.Mobile);
- end;
- RealICQContacterListItem.HasMobilePhone := (Length(Trim(RealICQUser.Mobile)) > 0) or (Length(Trim(ARemarkMobile)) > 0);
- RealICQContacterListItem.HasEmail := (Length(Trim(RealICQUser.Email)) > 0);
- RealICQContacterListItem.HasSMS := RealICQContacterListItem.HasMobilePhone;
- RealICQContacterListItem.HeadImageHint := '单击显示联系人卡片';
- if Length(Trim(ARemarkMobile)) > 0 then
- RealICQContacterListItem.MobilePhoneHint := Trim(ARemarkMobile)
- else
- RealICQContacterListItem.MobilePhoneHint := Trim(RealICQUser.Mobile);
- RealICQContacterListItem.Mobile := Trim(RealICQUser.Mobile);
- RealICQContacterListItem.Tel := Trim(RealICQUser.Tel);
- RealICQContacterListItem.HasMobilePhone := False;
- RealICQContacterListItem.MobilePhoneHint := RealICQContacterListItem.MobilePhoneHint + '(双击发送手机短信息)';
- RealICQContacterListItem.TelephoneHint := RealICQContacterListItem.TelephoneHint;
- RealICQContacterListItem.EmailHint := Trim(RealICQUser.Email) + '(双击发送邮件)';
- RealICQContacterListItem.SMSHint := RealICQContacterListItem.MobilePhoneHint;
- RealICQContacterListItem.CameraHint := '双击发送视频对话邀请';
- RealICQContacterListItem.HasTelephone := RealICQContacterListItem.HasTelephone and RealICQContacterListItem.ListView.ShowTelButton;
- RealICQContacterListItem.HasMobilePhone := RealICQContacterListItem.HasMobilePhone and RealICQContacterListItem.ListView.ShowMobileButton;
- RealICQContacterListItem.HasEmail := RealICQContacterListItem.HasEmail and RealICQContacterListItem.ListView.ShowEmailButton;
- RealICQContacterListItem.HasSMS := RealICQContacterListItem.HasSMS and RealICQContacterListItem.ListView.ShowSMSButton;
- if FileExists(RealICQUser.HeadImageFile) then
- begin
- try
- if (RealICQUser.HeadImageFileType = htGIF) then
- begin
- GIFImage := TGIFImage.Create;
- GIFImage.Animate := False;
- try
- GIFImage.LoadFromFile(RealICQUser.HeadImageFile);
- RealICQContacterListItem.HeadImagePicture.Bitmap.Assign(GIFImage);
- finally
- GIFImage.Free;
- end;
- end
- else
- RealICQContacterListItem.HeadImagePicture.LoadFromFile(RealICQUser.HeadImageFile);
- except
- RealICQContacterListItem.HeadImagePicture.Graphic := nil;
- end;
- end
- else
- RealICQContacterListItem.HeadImagePicture.Graphic := nil;
- RealICQContacterListItem.DisplayName := RealICQUser.DisplayName;
- RealICQContacterListItem.LoginState := RealICQUser.LoginState;
- RealICQContacterListItem.Data := RealICQUser;
- if ANeedFlash then
- RealICQContacterListItem.ReDrawItem;
- end;
- procedure TMainForm.BindUserDataToItemForGroup(RealICQContacterListItem: TRealICQContacterListItem; RealICQUser: TRealICQUser; AGroupAlias: string; ANeedFlash: Boolean);
- var
- GIFImage: TGIFImage;
- jo: IsuperObject;
- ARemarkTel, ARemarkMobile, ARemark: string;
- begin
- jo := TUserRemarkService.GetService.GetUserRemark(RealICQUser.LoginName);
- if jo <> nil then
- begin
- ARemark := jo.S['Remark'];
- ARemarkTel := jo.S['Phone'];
- ARemarkMobile := jo.S['Mobile'];
- end;
- RealICQContacterListItem.HasCamera := RealICQUser.InstalledCamera;
- RealICQContacterListItem.Watchword := RealICQUser.Watchword;
- RealICQContacterListItem.LeaveMessage := RealICQUser.LeaveMessage;
- RealICQContacterListItem.Branch := RealICQUser.Branch;
- RealICQContacterListItem.HasTelephone := (Length(Trim(ARemarkTel)) > 0) or (Length(Trim(RealICQUser.Tel)) > 0) or (Length(Trim(RealICQUser.Mobile)) > 0);
- RealICQContacterListItem.TelephoneHint := '';
- if Length(Trim(ARemarkTel)) > 0 then
- begin
- RealICQContacterListItem.TelephoneHint := RealICQContacterListItem.TelephoneHint + '备注:' + Trim(ARemarkTel);
- end;
- if Length(Trim(RealICQUser.Tel)) > 0 then
- begin
- if Length(Trim(RealICQContacterListItem.TelephoneHint)) > 0 then
- RealICQContacterListItem.TelephoneHint := RealICQContacterListItem.TelephoneHint + ' ';
- RealICQContacterListItem.TelephoneHint := RealICQContacterListItem.TelephoneHint + '电话:' + Trim(RealICQUser.Tel);
- end;
- if Length(Trim(RealICQUser.Mobile)) > 0 then
- begin
- if Length(Trim(RealICQContacterListItem.TelephoneHint)) > 0 then
- RealICQContacterListItem.TelephoneHint := RealICQContacterListItem.TelephoneHint + ' ';
- RealICQContacterListItem.TelephoneHint := RealICQContacterListItem.TelephoneHint + '手机:' + Trim(RealICQUser.Mobile);
- end;
- RealICQContacterListItem.HasMobilePhone := (Length(Trim(RealICQUser.Mobile)) > 0) or (Length(Trim(ARemarkMobile)) > 0);
- RealICQContacterListItem.HasEmail := (Length(Trim(RealICQUser.Email)) > 0);
- RealICQContacterListItem.HasSMS := RealICQContacterListItem.HasMobilePhone;
- RealICQContacterListItem.HeadImageHint := '单击显示联系人卡片';
- if Length(Trim(ARemarkMobile)) > 0 then
- RealICQContacterListItem.MobilePhoneHint := Trim(ARemarkMobile)
- else
- RealICQContacterListItem.MobilePhoneHint := Trim(RealICQUser.Mobile);
- RealICQContacterListItem.Mobile := Trim(RealICQUser.Mobile);
- RealICQContacterListItem.Tel := Trim(RealICQUser.Tel);
- RealICQContacterListItem.HasMobilePhone := False;
- RealICQContacterListItem.MobilePhoneHint := RealICQContacterListItem.MobilePhoneHint + '(双击发送手机短信息)';
- RealICQContacterListItem.TelephoneHint := RealICQContacterListItem.TelephoneHint;
- RealICQContacterListItem.EmailHint := Trim(RealICQUser.Email) + '(双击发送邮件)';
- RealICQContacterListItem.SMSHint := RealICQContacterListItem.MobilePhoneHint;
- RealICQContacterListItem.CameraHint := '双击发送视频对话邀请';
- RealICQContacterListItem.HasTelephone := RealICQContacterListItem.HasTelephone and RealICQContacterListItem.ListView.ShowTelButton;
- RealICQContacterListItem.HasMobilePhone := RealICQContacterListItem.HasMobilePhone and RealICQContacterListItem.ListView.ShowMobileButton;
- RealICQContacterListItem.HasEmail := RealICQContacterListItem.HasEmail and RealICQContacterListItem.ListView.ShowEmailButton;
- RealICQContacterListItem.HasSMS := RealICQContacterListItem.HasSMS and RealICQContacterListItem.ListView.ShowSMSButton;
- if FileExists(RealICQUser.HeadImageFile) then
- begin
- try
- if (RealICQUser.HeadImageFileType = htGIF) then
- begin
- GIFImage := TGIFImage.Create;
- GIFImage.Animate := False;
- try
- GIFImage.LoadFromFile(RealICQUser.HeadImageFile);
- RealICQContacterListItem.HeadImagePicture.Bitmap.Assign(GIFImage);
- finally
- GIFImage.Free;
- end;
- end
- else
- RealICQContacterListItem.HeadImagePicture.LoadFromFile(RealICQUser.HeadImageFile);
- except
- RealICQContacterListItem.HeadImagePicture.Graphic := nil;
- end;
- end
- else
- RealICQContacterListItem.HeadImagePicture.Graphic := nil;
- RealICQContacterListItem.DisplayName := AGroupAlias; //RealICQUser.DisplayName;
- RealICQContacterListItem.LoginState := RealICQUser.LoginState;
- RealICQContacterListItem.Data := RealICQUser;
- if ANeedFlash then
- RealICQContacterListItem.ReDrawItem;
- end;
- }
- //------------------------------------------------------------------------------
- procedure TMainForm.btCloseTopMessageClick(Sender: TObject);
- begin
- pnlForTopMessage.Visible := False;
- FTopSystemMessage := nil;
- end;
- procedure TMainForm.btCustomerDisplayNameClick(Sender: TObject);
- var
- Point: TPoint;
- begin
- Point.X := 0;
- Point.Y := btCustomerDisplayName.Height + 1;
- Point := btCustomerDisplayName.ClientToScreen(Point);
- ppChangeCustomerState.Popup(Point.X, Point.Y);
- end;
- procedure TMainForm.btLoginClick(Sender: TObject);
- var
- ca: ICAClient;
- b: Boolean;
- begin
- if RealICQClient.Logining then
- RealICQClient.CancelLogin
- else if RealICQClient.ReConnectExecuting then
- RealICQClient.CancelReConnectAndLogin
- else if actLoginAs.Visible and actLoginAs.Enabled and FLoginAsSavePassword then
- begin
- actLoginAs.Execute
- end
- else if RealICQClient.Logined then
- begin
- RealICQClient.Logout;
- end
- else
- begin
- if RealICQClient.CaEnable and RealICQClient.CALogin then
- begin
- b := actLoginAs.Enabled;
- actLoginAs.Enabled := true;
- actLoginAs.Execute;
- actLoginAs.Enabled := b;
- Exit;
- end;
- if Length(Trim(edLoginName.Text)) = 0 then
- begin
- MessageBox(Handle, '请输入用户名！', '提示', MB_ICONINFORMATION);
- Exit;
- end;
- if Length(edPassword.Text) = 0 then
- begin
- MessageBox(Handle, '请输入密码！', '提示', MB_ICONINFORMATION);
- Exit;
- end;
- RealICQClient.AutoLogin := FAutoLogin;
- RealICQClient.Login(Trim(edLoginName.Text), edPassword.Text, FLoginState, FLeaveMessage, FSavePassword, False, False);
- end;
- end;
- procedure TMainForm.btMainMenuClick(Sender: TObject);
- var
- Point: TPoint;
- begin
- edtSearchMoreUser.Text := '';
- Point.X := 24;
- Point.Y := btMainMenu.top;
- Point := btMainMenu.ClientToScreen(Point);
- ppMainMenu.Popup(Point.X, Point.Y - GetSystemMetrics(SM_CYMENU) * 8);
- end;
- procedure TMainForm.btnCALoginClick(Sender: TObject);
- begin
- RealICQClient.CALogin := not RealICQClient.CALogin;
- // if RealICQClient.CALogin then
- // begin
- // ImgLstCheckStates.GetIcon(1, btnCaLogin.Icon);
- //// edLoginName.Text := CA_TEXT;
- // edLoginName.Enabled := False;
- // edPassword.Enabled := False;
- // spbChangeLoginName.Enabled := False;
- // end
- // else
- // begin
- // ImgLstCheckStates.GetIcon(0, btnCaLogin.Icon);
- //// edLoginName.Text := '';
- // edLoginName.Enabled := True;
- // edPassword.Enabled := True;
- // spbChangeLoginName.Enabled := True;
- // end;
- SetLoginStateControlState;
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.cbxURLInputerDropDown(Sender: TObject);
- var
- iLoop: Integer;
- Items: TStringList;
- begin
- Items := TStringList.Create;
- try
- GetIEHistory(Items);
- cbxURLInputer.ItemsEx.Clear;
- for iLoop := 0 to Items.Count - 1 do
- begin
- with cbxURLInputer.ItemsEx.Add do
- begin
- Caption := Items.Strings[iLoop];
- if (Copy(Caption, 1, 5) = 'file:') or (Copy(Caption, 2, 1) = ':') then
- ImageIndex := 2
- else if Copy(Caption, 1, 4) = 'ftp:' then
- ImageIndex := 1
- else
- ImageIndex := 0;
- end;
- end;
- finally
- Items.Free;
- end;
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.cbxURLInputerKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
- begin
- if Key = 13 then
- spbGoClick(spbGo);
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.cbxURLInputerSelect(Sender: TObject);
- begin
- spbGoClick(spbGo);
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.SetStyleMenuChecked;
- begin
- case FLVStyle of
- lsBigHeadImage:
- actShowBigHeadImage.Checked := True;
- lsMiddleHeadImage:
- actShowMiddleHeadImage.Checked := True;
- lsSmallHeadImage:
- actShowSmallHeadImage.Checked := True;
- lsNoHeadImage:
- actShowNormalHeadImage.Checked := True;
- end;
- case FLVCaptionStyle of
- csDisplayName:
- actShowDisplayName.Checked := True;
- csLoginName:
- actShowLoginName.Checked := True;
- csDisplayNameAndLoginName:
- actShowAllName.Checked := True;
- end;
- actShowRemark.Checked := RealICQClient.ShowRemark;
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.SetLoginStateMenuChecked;
- var
- LeaveMsg: string;
- begin
- actOnline.Checked := False;
- actHidden.Checked := False;
- actOffline.Checked := False;
- actBusy.Checked := False;
- actMute.Checked := False;
- actLeave.Checked := False;
- actRepast.Checked := False;
- actPhone.Checked := False;
- actMeeting.Checked := False;
- actOtherState.Checked := False;
- if RealICQClient.Me = nil then
- begin
- actOffline.Checked := True;
- Exit;
- end;
- LeaveMsg := RealICQClient.Me.LeaveMessage;
- if RealICQClient.Me.LoginState = stOnline then
- actOnline.Checked := True
- else if RealICQClient.Me.LoginState = stHidden then
- actHidden.Checked := True
- else if RealICQClient.Me.LoginState = stLeave then
- begin
- if AnsiSameText(actLeave.Caption, LeaveMsg) then
- actLeave.Checked := True
- else if AnsiSameText(actRepast.Caption, LeaveMsg) then
- actRepast.Checked := True
- else if AnsiSameText(actMeeting.Caption, LeaveMsg) then
- actMeeting.Checked := True
- else
- actOtherState.Checked := True;
- end
- else if RealICQClient.Me.LoginState = stBusy then
- begin
- if AnsiSameText(actBusy.Caption, LeaveMsg) then
- actBusy.Checked := True
- else if AnsiSameText(actPhone.Caption, LeaveMsg) then
- actPhone.Checked := True
- else
- actOtherState.Checked := True;
- end
- else if RealICQClient.Me.LoginState = stMute then
- actMute.Checked := True
- else
- actOtherState.Checked := True;
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.ShowMeInformation;
- var
- ADisplayName, ATrueDisplayName, AWatchword, AStateMsg: WideString;
- HeadPic: TPicture;
- GIFImage: TGIFImage;
- begin
- if RealICQClient.Me = nil then
- Exit;
- if FNotReadMessages.Count = 0 then
- begin
- case RealICQClient.Me.LoginState of
- stOffline:
- TrayIcon.Icon.LoadFromFile(ExtractFilePath(Application.ExeName) + 'Images\State\TrayIcon\Offline.ico');
- stOnline:
- TrayIcon.Icon.LoadFromFile(ExtractFilePath(Application.ExeName) + 'Images\State\TrayIcon\Online.ico');
- stLeave:
- TrayIcon.Icon.LoadFromFile(ExtractFilePath(Application.ExeName) + 'Images\State\TrayIcon\leave.ico');
- stBusy:
- TrayIcon.Icon.LoadFromFile(ExtractFilePath(Application.ExeName) + 'Images\State\TrayIcon\Busy.ico');
- stMute:
- TrayIcon.Icon.LoadFromFile(ExtractFilePath(Application.ExeName) + 'Images\State\TrayIcon\Mute.ico');
- stHidden:
- TrayIcon.Icon.LoadFromFile(ExtractFilePath(Application.ExeName) + 'Images\State\TrayIcon\invisible.ico');
- end;
- TrayIcon.SetDefaultIcon;
- end;
- if FileExists(RealICQClient.Me.HeadImageFile) then
- begin
- try
- if (RealICQClient.Me.HeadImageFileType = htGIF) then
- begin
- GIFImage := TGIFImage.Create;
- GIFImage.Animate := FShowGIFInMailForm and (RealICQClient.Me.LoginState <> stHidden);
- try
- GIFImage.LoadFromFile(RealICQClient.Me.HeadImageFile);
- if GIFImage.Animate then
- imgHead.Picture.Assign(GIFImage)
- else
- imgHead.Picture.Bitmap.Assign(GIFImage);
- finally
- GIFImage.Free;
- end;
- end
- else
- imgHead.Picture.LoadFromFile(RealICQClient.Me.HeadImageFile);
- except
- imgHead.Picture.LoadFromFile(ExtractFilePath(Application.ExeName) + DefaultPictureBig);
- end;
- end
- else
- begin
- imgHead.Picture.LoadFromFile(ExtractFilePath(Application.ExeName) + DefaultPictureBig);
- end;
- {if RealICQClient.Me.LoginState = stHidden then
- begin
- HeadPic := TPicture.Create;
- try
- HeadPic.Bitmap.Assign(imgHead.Picture.Graphic);
- Grayscale(HeadPic.Bitmap);
- imgHead.Picture.Bitmap.Assign(HeadPic.Bitmap);
- finally
- HeadPic.Free;
- end;
- end;
- imgLeave.Visible := False;}
- case RealICQClient.Me.LoginState of
- stOffline:
- spbDisplayName.Icon.LoadFromFile(ExtractFilePath(Application.ExeName) + 'Images\State\Big\Offline.ico');
- stOnline:
- spbDisplayName.Icon.LoadFromFile(ExtractFilePath(Application.ExeName) + 'Images\State\Big\Online.ico');
- stLeave:
- spbDisplayName.Icon.LoadFromFile(ExtractFilePath(Application.ExeName) + 'Images\State\Big\away.ico');
- stBusy:
- spbDisplayName.Icon.LoadFromFile(ExtractFilePath(Application.ExeName) + 'Images\State\Big\Busy.ico');
- stMute:
- spbDisplayName.Icon.LoadFromFile(ExtractFilePath(Application.ExeName) + 'Images\State\Big\Mute.ico');
- stHidden:
- spbDisplayName.Icon.LoadFromFile(ExtractFilePath(Application.ExeName) + 'Images\State\Big\invisible.ico');
- end;
- if (RealICQClient.Me.LoginState = stLeave) or (RealICQClient.Me.LoginState = stBusy) then
- AStateMsg := RealICQClient.Me.LeaveMessage
- else
- begin
- if RealICQClient.Me.LoginState = stMobileOnline then
- AStateMsg := StateValues[Integer(RealICQClient.Me.LoginState)]
- else
- AStateMsg := StateValues[Integer(RealICQClient.Me.LoginState) mod 5];
- end;
- ATrueDisplayName := RealICQClient.Me.Nickname;
- ADisplayName := ATrueDisplayName + '（' + AStateMsg + '）';
- spbDisplayName.Hint := ADisplayName;
- spbDisplayName.ShowHint := False;
- TrayIcon.Hint := Application.Title + ' - ' + ADisplayName;
- AWatchword := RealICQClient.Me.Watchword;
- if Length(Trim(AWatchword)) = 0 then
- AWatchword := '在此键入您的个性签名';
- spbWatchword.Hint := AWatchword;
- spbWatchword.ShowHint := False;
- btn_lock_DisplayName.Caption := ADisplayName; // + Format('(%s)', [StateValues[Integer(RealICQClient.Me.LoginState)]]);
- btn_lock_DisplayName.AutoSize := False;
- btn_lock_DisplayName.AutoSize := True;
- btn_lock_DisplayName.Update;
- img_lock_HeadPrev.Picture := imgHead.Picture;
- //字符串长度过长时,截短字符串并在后面显示“...”
- while spbDisplayName.Canvas.TextWidth(ADisplayName) > pnlTop.Width - 86 do
- begin
- if Length(ATrueDisplayName) > 3 then
- begin
- if Copy(ATrueDisplayName, Length(ATrueDisplayName) - 2, Length(ATrueDisplayName)) = '...' then
- ATrueDisplayName := Copy(ATrueDisplayName, 1, Length(ATrueDisplayName) - 3);
- ATrueDisplayName := Copy(ATrueDisplayName, 1, Length(ATrueDisplayName) - 1) + '...';
- end
- else if Length(AStateMsg) > 3 then
- begin
- if Copy(AStateMsg, Length(AStateMsg) - 2, Length(AStateMsg)) = '...' then
- AStateMsg := Copy(AStateMsg, 1, Length(AStateMsg) - 3);
- AStateMsg := Copy(AStateMsg, 1, Length(AStateMsg) - 1) + '...';
- end
- else
- break;
- ADisplayName := ATrueDisplayName + '（' + AStateMsg + '）';
- spbDisplayName.ShowHint := True;
- end;
-
- //字符串长度过长时,截短字符串并在后面显示“...”
- while spbWatchword.Canvas.TextWidth(AWatchword) > pnlTop.Width - 86 do
- begin
- if Length(AWatchword) > 3 then
- begin
- if Copy(AWatchword, Length(AWatchword) - 2, Length(AWatchword)) = '...' then
- AWatchword := Copy(AWatchword, 1, Length(AWatchword) - 3);
- AWatchword := Copy(AWatchword, 1, Length(AWatchword) - 1) + '...';
- end
- else
- break;
- spbWatchword.ShowHint := True;
- end;
- spbDisplayName.Caption := ADisplayName;
- spbWatchword.Caption := AWatchword;
- edWatchword.Text := RealICQClient.Me.Watchword;
- if OptionsForm <> nil then
- begin
- OptionsForm.ShowHeadImage;
- OptionsForm.GetSets;
- //OptionsForm.GetPersonalSet;
- end;
- SetLoginStateMenuChecked;
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.RealICQClientGetDBProcedureResult(Sender: TObject; DBProcedureName, ArgIn, ArgOut: string);
- var
- WebPanel: TWebPanel;
- WebTabAcount: TWebTabAcount;
- StrList1, StrList2: TStringList;
- iLoop, iIndex: Integer;
- begin
- if AnsiSameText(DBProcedureName, 'YJ_AddTempRemark') then
- begin
- ShellExecute(handle, 'open', PChar(GetDefaultBrowser), PChar(Format(MainForm.RealICQClient.WebAppBaseURL + LoginURL, [StrToBase64(MainForm.RealICQClient.LoginName), StrToBase64(MD5En(MainForm.RealICQClient.Password)), StrToBase64(Format(AddRemarkURL, [ArgOut]))])), '', SW_SHOWDEFAULT);
- end;
- if AnsiSameText(DBProcedureName, 'GetWebTabAcounts') then
- begin
- StrList1 := SplitString(ArgOut, Chr(13));
- for iLoop := 0 to StrList1.Count - 1 do
- begin
- if StrList1.Strings[iLoop] = '' then
- Continue;
- StrList2 := SplitString(StrList1.Strings[iLoop], Chr(10));
- WebTabAcount := TWebTabAcount.Create;
- try
- WebTabAcount.FWebTabID := StrToInt(StrList2.Strings[0]);
- WebTabAcount.FTitle := StrList2.Strings[1];
- WebTabAcount.LoginName := StrList2.Strings[2];
- WebTabAcount.FPassword := StrList2.Strings[3];
- WebTabAcount.FExplain := StrList2.Strings[4];
- iIndex := FWebPanels.IndexOf(IntToStr(WebTabAcount.FWebTabID));
- if iIndex >= 0 then
- begin
- WebPanel := FWebPanels.Objects[iIndex] as TWebPanel;
- WebPanel.FAcounts.Add(WebTabAcount);
- end;
- except
- FreeAndNil(WebTabAcount);
- end;
- end;
- end;
- end;
- procedure TMainForm.RealICQClientGetNotReadMessageCount(Sender: TObject; iCount: Integer);
- begin
- spbShowNotReadMessage.Caption := Format('(%d)', [iCount]);
- end;
- procedure TMainForm.RealICQClientGetSystemNoticesCount(Sender: TObject; iCount: Integer; NoticesRecords: array of TSystemNotices);
- var
- iLoop: Integer;
- ANoticesRecord: TSystemNotices;
- begin
- FLastGetSystemNoticesTicket := GetTickCount;
- while FSystemNotices.Count > 0 do
- begin
- ANoticesRecord := FSystemNotices[0];
- FSystemNotices.Delete(0);
- try
- FreeAndNil(ANoticesRecord);
- except
- end;
- end;
- for iLoop := Low(NoticesRecords) to High(NoticesRecords) do
- begin
- ANoticesRecord := NoticesRecords[iLoop];
- FSystemNotices.Add(ANoticesRecord);
- end;
- pnlForTopMessage.Visible := iCount > 0;
- TimerForShowSystemNotices.Enabled := pnlForTopMessage.Visible;
- FSystemNoticeIndex := 0;
- if pnlForTopMessage.Visible then
- begin
- ShowSystemNotices;
- end;
- end;
- procedure TMainForm.TimerForShowSystemNoticesTimer(Sender: TObject);
- begin
- TimerForShowSystemNotices.Enabled := pnlForTopMessage.Visible;
- btNextLogClick(nil);
- if GetTickCount - FLastGetSystemNoticesTicket > 60000 * 30 then
- begin
- TimerForShowSystemNotices.Enabled := False;
- RealICQClient.SendGetNewInformation(1);
- end;
- end;
- procedure TMainForm.ShowSystemNotices;
- var
- ANoticesRecord: TSystemNotices;
- begin
- ANoticesRecord := FSystemNotices[FSystemNoticeIndex];
- while ANoticesRecord.EndDate < Now do
- begin
- FSystemNotices.Delete(FSystemNoticeIndex);
- FreeAndNil(ANoticesRecord);
- if FSystemNotices.Count > 0 then
- begin
- if FSystemNoticeIndex >= FSystemNotices.Count then
- FSystemNoticeIndex := FSystemNotices.Count - 1;
- if FSystemNoticeIndex < 0 then
- FSystemNoticeIndex := 0;
- ANoticesRecord := FSystemNotices[FSystemNoticeIndex];
- end
- else
- begin
- pnlForTopMessage.Visible := False;
- TimerForShowSystemNotices.Enabled := False;
- Exit;
- end;
- end;
- lblLogsTitle.Caption := Format('系统公告(%d/%d)', [FSystemNoticeIndex + 1, FSystemNotices.Count]);
- lblLogs.Caption := ANoticesRecord.Title;
- lblLogs.Hint := ANoticesRecord.Title + '(有效期：' + DateTimeToStr(ANoticesRecord.EndDate) + ')';
- TimerForShowSystemNotices.Enabled := False;
- TimerForShowSystemNotices.Enabled := FSystemNotices.Count > 0;
- end;
- procedure TMainForm.btNextLogClick(Sender: TObject);
- begin
- Inc(FSystemNoticeIndex, 1);
- if FSystemNoticeIndex >= FSystemNotices.Count then
- FSystemNoticeIndex := 0;
- ShowSystemNotices;
- end;
- procedure TMainForm.btn_lockClick(Sender: TObject);
- var
- iLoop: Integer;
- AForm: TSMSForm;
- begin
- if Assigned(MessageBoxForm) then
- MessageBoxForm.Hide;
- if Assigned(MessagesManagerForm) then
- MessagesManagerForm.Visible := False;
- if Assigned(SearchForm) then
- SearchForm.Visible := False;
- for iLoop := SMSForms.Count - 1 downto 0 do
- begin
- AForm := SMSForms[iLoop];
- AForm.Visible := False;
- end;
- pnlLocked.Visible := True;
- pnlLocked.BringToFront;
- ChangeTalkingFormVisible(False);
- end;
- procedure TMainForm.btn_unlockClick(Sender: TObject);
- var
- APassword: string;
- iLoop: Integer;
- AForm: TSMSForm;
- begin
- actOpenMainForm.Execute;
- APassword := ShowMyInputBox(PChar('解锁'), PChar('请输入您的登录密码以解除锁定状态！ '), '', 32);
- if Trim(APassword) = '' then
- Exit;
- if AnsiSameText(APassword, MainForm.RealICQClient.Password) then
- begin
- ChangeTalkingFormVisible(True);
- pnlLocked.Visible := False;
- pnlMiddleClient.Visible := RealICQClient.Logined and RealICQClient.Connected;
- if Assigned(MessagesManagerForm) then
- MessagesManagerForm.Visible := True;
- if Assigned(SearchForm) then
- SearchForm.Visible := True;
- for iLoop := SMSForms.Count - 1 downto 0 do
- begin
- AForm := SMSForms[iLoop];
- AForm.Visible := True;
- end;
- end
- else
- begin
- showmessage('您输入的密码有误! ');
- end;
- end;
- procedure TMainForm.btPrevLogClick(Sender: TObject);
- begin
- Dec(FSystemNoticeIndex, 1);
- if FSystemNoticeIndex < 0 then
- FSystemNoticeIndex := FSystemNotices.Count - 1;
- ShowSystemNotices;
- end;
- procedure TMainForm.spbShowNotReadMessageClick(Sender: TObject);
- begin
- { if MessageBoxForm=nil then
- begin
- MessageBoxForm:=TMessageBoxForm.Create(self);
- end;
- MessageBoxForm.Show; }
- if FNewConsole then
- ShellExecute(handle, 'open', PChar(GetDefaultBrowser), PChar(Format(RealICQClient.WebAppBaseURL + NewBaseURL, [StrToBase64(RealICQClient.LoginName), StrToBase64(MD5En(RealICQClient.Password)), StrToBase64(InBoxURL)])), '', SW_SHOWDEFAULT)
- else
- ShellExecute(handle, 'open', PChar(GetDefaultBrowser), PChar(Format(RealICQClient.WebAppBaseURL + BaseURL, [StrToBase64(RealICQClient.LoginName), StrToBase64(MD5En(RealICQClient.Password)), StrToBase64(InBoxURL)])), '', SW_SHOWDEFAULT);
- end;
- //----------------------------------------------
- procedure TMainForm.OpenNewWorkDisk(Path: string);
- var
- UserInfo: string;
- C: TCopyDataStruct;
- hwnd: THandle;
- begin
- WinExec(PChar(ExtractFilePath(Application.ExeName) + Path), sw_show);
- UserInfo := RealICQClient.LoginName + #10 + RealICQClient.Password;
- with c do
- begin
- dwData := WM_COPYDATA;
- lpData := PChar(UserInfo + #0);
- cbData := Length(UserInfo) + 2;
- end;
- hWnd := FindWindow(pchar('TMainForm'), pchar('网络存储'));
- if hWnd <> 0 then
- SendMessage(hwnd, WM_COPYDATA, 0, integer(@c));
- end;
- //---------------------------------------------------
- procedure TMainForm.SaveBranchUserDataToXML(FileName: string);
- var
- iLoop: Integer;
- XMLDocument: TXMLDocument;
- Nodes, BranchsNode, BranchNode, UsersNode, UserNode: IXMLNode;
- BranchInfo: TRealICQBranchInfo;
- RealICQUser: TRealICQUser;
- LoginName: string;
- AUsers: TStringList;
- begin
- XMLDocument := TXMLDocument.Create(Self);
- try
- try
- XMLDocument.Active := True;
- if not FileExists(FileName) then
- begin
- XMLDocument.XML.Text := '<?xml version="1.0"?><Data>' + '<Branchs>' + '</Branchs>' + '<Users>' + '</Users></Data>';
- XMLDocument.Active := True;
- end
- else
- begin
- XMLDocument.LoadFromFile(FileName);
- end;
- Nodes := XMLDocument.DocumentElement;
- BranchsNode := Nodes.ChildNodes.Get(0);
- UsersNode := Nodes.ChildNodes.Get(1);
- BranchsNode.ChildNodes.Clear;
- UsersNode.ChildNodes.Clear;
- for iLoop := 0 to self.RealICQClient.Branchs.Count - 1 do
- begin
- BranchInfo := RealICQClient.Branchs.Objects[iLoop] as TRealICQBranchInfo;
- BranchNode := BranchsNode.AddChild('Branch');
- BranchNode.Attributes['ID'] := BranchInfo.ID;
- BranchNode.Attributes['Name'] := BranchInfo.BranchName;
- BranchNode.Attributes['ParentID'] := BranchInfo.ParentID;
- end;
- AUsers := TUsersService.GetUsersService.GetWorkmatesAndFriends;
- try
- for iLoop := 0 to AUsers.Count - 1 do
- begin
- RealICQUser := AUsers.Objects[iLoop] as TRealICQUser;
- LoginName := RealICQUser.LoginName;
- if AnsiPos('+', LoginName) > 0 then
- LoginName := Copy(LoginName, AnsiPos('+', LoginName) + 1, Length(LoginName) - AnsiPos('+', LoginName));
- UserNode := UsersNode.AddChild('User');
- UserNode.Attributes['LoginName'] := LoginName;
- UserNode.Attributes['DisplayName'] := RealICQUser.DisplayName;
- UserNode.Attributes['BranchID'] := RealICQUser.BranchID;
- end;
- finally
- FreeAndNil(AUsers);
- end;
- XMLDocument.SaveToFile(FileName);
- except
- on E: Exception do
- showmessage(e.Message);
- end;
- finally
- XMLDocument.Free;
- end;
- end;
- //------网络存储-------------------------------------
- procedure TMainForm.spbNetworkBackupClick(Sender: TObject);
- var
- UserInfo, LoginName: string;
- C: TCopyDataStruct;
- hwnd: THandle;
- FilePath: string;
- begin
- FilePath := ExtractFilePath(paramstr(0)) + 'NetworkBackup\';
- SaveBranchUserDataToXml(FilePath + 'BranchUsers.XML');
- LoginName := RealICQClient.LoginName;
- if AnsiPos('+', LoginName) > 0 then
- LoginName := Copy(LoginName, AnsiPos('+', LoginName) + 1, Length(LoginName) - AnsiPos('+', LoginName));
- WinExec(PChar(FilePath + 'NetworkBackup.exe ' + LoginName + ' ' + RealICQClient.Password), sw_show);
- end;
- procedure TMainForm.RealICQClientGettedAudioTransmiteConnectted(Sender: TObject; ALoginName: string);
- var
- TalkingForm: TTalkingForm;
- begin
- TalkingForm := GetTalkingForm(ALoginName, Sender as TRealICQClient);
- if TalkingForm = nil then
- Exit;
- if TalkingForm.CanWriteMessage then
- TalkingForm.ShowGettedAudioTransmiteConnectted;
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.RealICQClientGettedAudioTransmiteRequest(Sender: TObject; ALoginName: string);
- var
- AShowActive: Boolean;
- TalkingForm: TTalkingForm;
- iWaitTimes: Integer;
- begin
- AShowActive := (RealICQClient.IsAutoState = True) and (RealICQClient.Me.LoginState = stBusy) and AnsiSameText(RealICQClient.Me.LeaveMessage, '忙碌');
- TalkingForm := GetTalkingForm(ALoginName, Sender as TRealICQClient);
- if TalkingForm = nil then
- begin
- TalkingForm := OpenTalkingForm(ALoginName, not AShowActive, Sender as TRealICQClient);
- end;
- iWaitTimes := 0;
- while not TalkingForm.CanWriteMessage do
- begin
- Application.ProcessMessages;
- Inc(iWaitTimes);
- if iWaitTimes > 1000 then
- break;
- Sleep(10);
- end;
- if (GetForegroundWindow <> TalkingForm.Handle) then
- begin
- FlashWindow(TalkingForm.Handle, True);
- if PlaySoundOnGetMessage then
- PlayEventSound(FMessageEventSound);
- end;
- TalkingForm.ShowGettedAudioTransmiteRequest;
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.RealICQClientGettedAudioTransmiteResponse(Sender: TObject; ALoginName: string; AAcceptted: Boolean);
- var
- TalkingForm: TTalkingForm;
- begin
- TalkingForm := GetTalkingForm(ALoginName, Sender as TRealICQClient);
- if TalkingForm = nil then
- Exit;
- if TalkingForm.CanWriteMessage then
- TalkingForm.ShowGettedAudioTransmiteResponse(AAcceptted);
- end;
- //------显示全市页面查询结果------------------------------------------------------------------------
- procedure TMainForm.RealICQClientSearchUserResult(Sender: TObject);
- var
- iIndex, iLoop: Integer;
- ListItem: TRealICQContacterListItem;
- RealICQUser: TRealICQUser;
- Branch: TRealICQBranch;
- RealICQContacterTreeView: TRealICQContacterTreeView;
- begin
- iIndex := FContacterListViews.IndexOf(LVMoreUsers);
- FSearchMoreUserListView := FContacterListViews.Objects[iIndex] as TRealICQContacterListView;
- for iLoop := 0 to RealICQClient.SearchUsers.Count - 1 do
- begin
- RealICQUser := RealICQClient.SearchUsers.Objects[iLoop] as TRealICQUser;
- iIndex := FSearchMoreUserListView.Items.IndexOf(RealICQUser.LoginName);
- if iIndex = -1 then
- begin
- iIndex := FSearchMoreUserListView.Items.Add(RealICQUser.LoginName);
- ListItem := FSearchMoreUserListView.Items.Objects[iIndex] as TRealICQContacterListItem;
- ListItem.DisplayName := RealICQUser.DisplayName;
- ListItem.LoginState := RealICQUser.LoginState;
- ListItem.Data := RealICQUser;
- Application.ProcessMessages;
- end;
- end;
- RealICQContacterTreeView := FContacterTreeViews.Objects[FContacterTreeViews.IndexOf(LVMoreUsers)] as TRealICQContacterTreeView;
- for iLoop := 0 to RealICQContacterTreeView.BranchItems.Count - 1 do
- begin
- Branch := RealICQContacterTreeView.BranchItems.Objects[iLoop] as TRealICQBranch;
- if (AnsiPos(UpperCase(RealICQClient.KeyWord), UpperCase(Branch.BranchName)) > 0) or (AnsiPos(UpperCase(RealICQClient.KeyWord), GetPYIndexString(Branch.BranchName)) > 0) then
- begin
- iIndex := FSearchMoreUserListView.Items.Add(Branch.BranchName);
- ListItem := FSearchMoreUserListView.Items.Objects[iIndex] as TRealICQContacterListItem;
- ListItem.DisplayName := Branch.BranchName;
- ListItem.LoginState := stOnline;
- ListItem.StateIndex := 0;
- ListItem.Data := Branch;
- ListItem.HeadImagePicture.LoadFromFile(ExtractFilePath(Application.ExeName) + BranchCollapsedBMP);
- end;
- end;
- PostMessage(FSearchMoreUserListView.Handle, WM_SIZE, 0, 0);
- ImgLogining.Visible := False;
- ScrollBoxSearchMoreUser.Visible := FSearchMoreUserListView.Items.Count > 0;
- LblSearchHint.Visible := not ScrollBoxSearchMoreUser.Visible;
- LblSearchHint.Caption := '没有找到相关记录';
- end;
- procedure TMainForm.RealICQClientSendedAudioTransmiteRequest(Sender: TObject; ALoginName: string);
- var
- TalkingForm: TTalkingForm;
- begin
- TalkingForm := GetTalkingForm(ALoginName, Sender as TRealICQClient);
- if TalkingForm = nil then
- Exit;
- if TalkingForm.CanWriteMessage then
- TalkingForm.ShowSendedAudioTransmiteRequest;
- end;
- procedure TMainForm.RealICQClientSendedRemoteControlTransmiteControlRequest(Sender: TObject; ALoginName: string);
- var
- TalkingForm: TTalkingForm;
- begin
- TalkingForm := GetTalkingForm(ALoginName, Sender as TRealICQClient);
- if TalkingForm = nil then
- Exit;
- if TalkingForm.CanWriteMessage then
- TalkingForm.ShowSendedRemoteControlTransmiteControlRequest;
- end;
- procedure TMainForm.RealICQClientSendedRemoteControlTransmiteRequest(Sender: TObject; ALoginName: string);
- var
- TalkingForm: TTalkingForm;
- begin
- TalkingForm := GetTalkingForm(ALoginName, Sender as TRealICQClient);
- if TalkingForm = nil then
- Exit;
- if TalkingForm.CanWriteMessage then
- TalkingForm.ShowSendedRemoteControlTransmiteRequest;
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.RealICQClientGettedCancelAudioTransmite(Sender: TObject; ALoginName: string);
- var
- TalkingForm: TTalkingForm;
- begin
- TalkingForm := GetTalkingForm(ALoginName, Sender as TRealICQClient);
- if TalkingForm = nil then
- Exit;
- if TalkingForm.CanWriteMessage then
- TalkingForm.ShowCanceledAudioTransmite;
- end;
- procedure TMainForm.RealICQClientGettedCancelRemoteControlTransmite(Sender: TObject; ALoginName: string);
- var
- TalkingForm: TTalkingForm;
- begin
- TalkingForm := GetTalkingForm(ALoginName, Sender as TRealICQClient);
- if TalkingForm = nil then
- Exit;
- if TalkingForm.CanWriteMessage then
- TalkingForm.ShowCanceledRemoteControlTransmite;
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.RealICQClientGettedStopAudioTransmite(Sender: TObject; ALoginName: string; AIsStopper: Boolean);
- var
- TalkingForm: TTalkingForm;
- begin
- TalkingForm := GetTalkingForm(ALoginName, Sender as TRealICQClient);
- if TalkingForm = nil then
- Exit;
- if TalkingForm.CanWriteMessage then
- TalkingForm.ShowStoppedAudioTransmite(AIsStopper);
- end;
- procedure TMainForm.RealICQClientGettedStopRemoteControlTransmite(Sender: TObject; ALoginName: string; AIsStopper: Boolean);
- var
- TalkingForm: TTalkingForm;
- begin
- TalkingForm := GetTalkingForm(ALoginName, Sender as TRealICQClient);
- if TalkingForm = nil then
- Exit;
- if TalkingForm.CanWriteMessage then
- TalkingForm.ShowStoppedRemoteControlTransmite(AIsStopper);
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.RealICQClientGettedVideoTransmiteConnectted(Sender: TObject; ALoginName: string; ASendBigBmp, ARecvBigBmp: Boolean);
- var
- TalkingForm: TTalkingForm;
- begin
- TalkingForm := GetTalkingForm(ALoginName, Sender as TRealICQClient);
- if TalkingForm = nil then
- Exit;
- if TalkingForm.CanWriteMessage then
- TalkingForm.ShowGettedVideoTransmiteConnectted(ASendBigBmp, ARecvBigBmp);
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.RealICQClientGettedVideoTransmiteRequest(Sender: TObject; ALoginName: string);
- var
- AShowActive: Boolean;
- TalkingForm: TTalkingForm;
- iWaitTimes: Integer;
- begin
- AShowActive := (RealICQClient.IsAutoState = True) and (RealICQClient.Me.LoginState = stBusy) and AnsiSameText(RealICQClient.Me.LeaveMessage, '忙碌');
- TalkingForm := GetTalkingForm(ALoginName, Sender as TRealICQClient);
- if TalkingForm = nil then
- begin
- TalkingForm := OpenTalkingForm(ALoginName, not AShowActive, Sender as TRealICQClient);
- end;
- iWaitTimes := 0;
- while not TalkingForm.CanWriteMessage do
- begin
- Application.ProcessMessages;
- Inc(iWaitTimes);
- if iWaitTimes > 1000 then
- break;
- Sleep(10);
- end;
- if (GetForegroundWindow <> TalkingForm.Handle) then
- begin
- FlashWindow(TalkingForm.Handle, True);
- if PlaySoundOnGetMessage then
- PlayEventSound(FMessageEventSound);
- end;
- TalkingForm.ShowGettedVideoTransmiteRequest;
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.RealICQClientGettedVideoTransmiteResponse(Sender: TObject; ALoginName: string; AAcceptted: Boolean);
- var
- TalkingForm: TTalkingForm;
- begin
- TalkingForm := GetTalkingForm(ALoginName, Sender as TRealICQClient);
- if TalkingForm = nil then
- Exit;
- if TalkingForm.CanWriteMessage then
- TalkingForm.ShowGettedVideoTransmiteResponse(AAcceptted);
- end;
- procedure TMainForm.RealICQClientGettedWebUrl(Sender: TObject);
- begin
- // if trim(RealICQClient.WeatherUrl)<>'' then
- // begin
- // FDownFile.OnComplete:=DownFileComplete;
- // FDownFile.ThreadDownFile(RealICQClient.WeatherUrl,ExtractFilePath(Application.ExeName)+'Weather.txt');
- // end;
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.RealICQClientSendedVideoTransmiteRequest(Sender: TObject; ALoginName: string);
- var
- TalkingForm: TTalkingForm;
- begin
- TalkingForm := GetTalkingForm(ALoginName, Sender as TRealICQClient);
- if TalkingForm = nil then
- Exit;
- if TalkingForm.CanWriteMessage then
- TalkingForm.ShowSendedVideoTransmiteRequest;
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.RealICQClientGettedCancelVideoTransmite(Sender: TObject; ALoginName: string);
- var
- TalkingForm: TTalkingForm;
- begin
- TalkingForm := GetTalkingForm(ALoginName, Sender as TRealICQClient);
- if TalkingForm = nil then
- Exit;
- if TalkingForm.CanWriteMessage then
- TalkingForm.ShowCanceledVideoTransmite;
- end;
- procedure TMainForm.RealICQClientGettedCanSendSMSCount(Sender: TObject);
- begin
- UpdateCanSendSMSCount;
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.RealICQClientGettedStopVideoTransmite(Sender: TObject; ALoginName: string; AIsStopper: Boolean);
- var
- TalkingForm: TTalkingForm;
- begin
- TalkingForm := GetTalkingForm(ALoginName, Sender as TRealICQClient);
- if TalkingForm = nil then
- Exit;
- if TalkingForm.CanWriteMessage then
- TalkingForm.ShowStoppedVideoTransmite(AIsStopper);
- end;
- //---显示黑名单-------------------------------------------------------------
- procedure TMainForm.ShowBlacklists;
- var
- iLoop, ItemIndex: Integer;
- RealICQUser: TRealICQUser;
- FriendTreeView: TRealICQContacterTreeView;
- Friend: TRealICQEmployee;
- begin
- SetFlashCaptionOnOnlineValue(False);
- try
- ItemIndex := FContacterTreeViews.IndexOf(LvFriends);
- FriendTreeView := FContacterTreeViews.Objects[ItemIndex] as TRealICQContacterTreeView;
- for iLoop := 0 to RealICQClient.Blacklists.Count - 1 do
- begin
- RealICQUser := RealICQClient.Blacklists.Objects[iLoop] as TRealICQUser;
- if trim(RealICQUser.DisplayName) = '' then
- TUsersService.GetUsersService.GetOrRequestUser(RealICQUser.LoginName, RealICQClient);
- if (FriendTreeView.EmployeeItems.IndexOf(RealICQUser.LoginName)) >= 0 then
- Continue;
- Friend := TRealICQEmployee.Create(RealICQUser.LoginName);
- Friend.BranchID := LVBlackLists;
- FriendTreeView.AddEmployee(Friend);
- //UpdateFriendNode(Friend, RealICQUser, False);
- TUsersService.GetUsersService.UpdateTreeNode(FriendTreeView, Friend, RealICQUser, False);
- end;
- finally
- SetFlashCaptionOnOnlineValue(FFlashCaptionOnOnline);
- end;
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.RealICQClientGettedBlacklists(Sender: TObject);
- begin
- ShowBlacklists;
- end;
- //-------显示与自己不同部门的联系人------------------------------
-
procedure TMainForm.RealICQClientGettedBranchUser(Sender: TObject);
- var
- iLoop, ItemIndex: Integer;
- RealICQUser: TRealICQUser;
- RealICQContacterTreeView: TRealICQContacterTreeView;
- Employee: TRealICQEmployee;
- TmpBranch, RootBranch: TRealICQBranch;
- OnlineEmployee: Integer;
- begin
- // TmpBranch:=nil;
- // RootBranch:=nil;
- // ItemIndex := FContacterTreeViews.IndexOf(LVMyContacters);
- // RealICQContacterTreeView := FContacterTreeViews.Objects[ItemIndex] as TRealICQContacterTreeView;
- // RealICQContacterTreeView.OnHeadImageMouseEnter := NodeOnHeadImageMouseEnter;
- // RealICQContacterTreeView.OnHeadImageMouseLeave := NodeOnHeadImageMouseLeave;
- // RealICQContacterTreeView.AdjustPosition :=False;
- // RealICQContacterTreeView.HideSystemScrollBar;
- // pgcMainWorkArea.DisableAlign;
- // RealICQContacterTreeView.BeginUpdate;
- // try
- // ItemIndex := RealICQContacterTreeView.EmployeeItems.IndexOf('正在下载用户');
- // if ItemIndex>=0 then
- // RealICQContacterTreeView.EmployeeItems.Delete(ItemIndex);
- // OnlineEmployee:=0;
- //
- // for iLoop:=0 to RealICQContacterTreeView.EmployeeItems.Count-1 do
- // begin
- // Employee:=RealICQContacterTreeView.EmployeeItems.Objects[iLoop] as TRealICQEmployee;
- // if (Employee.LoginState <> stOffline) and (Employee.LoginState <> stHidden) then
- // OnlineEmployee := OnlineEmployee + 1;
- // end;
- // for iLoop := 0 to RealICQContacterTreeView.BranchItems.Count - 1 do
- // begin
- // TmpBranch:=RealICQContacterTreeView.BranchItems.Objects[iLoop] as TRealICQBranch;
- // if not TmpBranch.IsGetUserList then
- // begin
- // TmpBranch.OnlineEmployee:=0;
- // TmpBranch.EmployeeCount:=0;
- // TmpBranch.IsGetUserList:=True;
- // end;
- // if (TmpBranch.ParentID='0') then
- // RootBranch:=TmpBranch
- // end;
- // if RootBranch<>nil then
- // begin
- // RootBranch.OnlineEmployee:=OnlineEmployee;
- // RootBranch.EmployeeCount:= RealICQContacterTreeView.EmployeeItems.Count;
- // end;
- // {$region '添加联系人'}
- // for iLoop := RealICQClient.Friends.Count - 1 downto 0 do
- // begin
- // RealICQUser := RealICQClient.Friends.Objects[iLoop] as TRealICQUser;
- // if (RealICQContacterTreeView.EmployeeItems.IndexOf(RealICQUser.LoginName)) >= 0 then Continue;
- // if AnsiSameText(RealICQUser.BranchID, 'U') then Continue;
- //
- // Employee := TRealICQEmployee.Create(RealICQUser.LoginName);
- // Employee.BranchID := RealICQUser.BranchID;
- // Employee.HasAddFriend:=False;
- // Employee.HasEmail :=False;
- // RealICQContacterTreeView.AddEmployee(Employee);
- // if Assigned(Employee.Node.Parent) then
- // begin
- // UpdateEmployeeNode(Employee, RealICQUser, False);
- // end
- // else
- // FreeAndNil(Employee);
- // end;
- // {$endregion}
- // PostMessage(RealICQContacterTreeView.Handle, WM_SIZE, 0, 0);
- // finally
- // RealICQContacterTreeView.EndUpdate;
- // pgcMainWorkArea.EnableAlign;
- // end;
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.LoadLatests;
- var
- FLatestUsers: TStringList;
- RealICQUser: TRealICQUser;
- RealICQContacterListItem: TRealICQContacterListItem;
- iLoop, ItemIndex: Integer;
- LoginName: string;
- begin
- FLatestUsers := DBHistory.GetLatests(RealICQClient.LoginName);
- try
- for iLoop := 0 to FLatestUsers.Count - 1 do
- begin
- if iLoop >= 20 then
- Break;
- LoginName := FLatestUsers[iLoop];
- if (AnsiPos('+', LoginName) <= 0) and (trim(RealICQClient.CenterServerID) <> '') then
- LoginName := RealICQClient.CenterServerID + '+' + LoginName;
- RealICQUser := TUsersService.GetUsersService.GetOrRequestUser(LoginName);
- if RealICQUser = nil then
- Continue;
- if not AnsiSameText(RealICQUser.LoginName, RealICQClient.LoginName) then
- begin
- ItemIndex := FLVLatests.Items.IndexOf(RealICQUser.LoginName);
- if ItemIndex = -1 then
- ItemIndex := FLVLatests.Items.Add(RealICQUser.LoginName);
- RealICQContacterListItem := FLVLatests.Items.Objects[ItemIndex] as TRealICQContacterListItem;
- //BindUserDataToItem(RealICQContacterListItem, RealICQUser);
- TUsersService.GetUsersService.UpdateListItem(FLVLatests, RealICQContacterListItem, RealICQUser);
- end;
- end;
- finally
- FreeAndNil(FLatestUsers);
- end;
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.GetOtherBranchs;
- var
- iLoop: Integer;
- RealICQUser: TRealICQUser;
- ALoginNames: string;
- begin
- ALoginNames := '';
- for iLoop := 0 to FNotAddedEmployeeList.Count - 1 do
- begin
- RealICQUser := FNotAddedEmployeeList.Objects[iLoop] as TRealICQUser;
- ALoginNames := ALoginNames + RealICQUser.LoginName;
- if (iLoop < FNotAddedEmployeeList.Count - 1) then
- ALoginNames := ALoginNames + Chr(10);
- end;
- if (Length(Trim(ALoginNames)) > 0) then
- RealICQClient.SendGetFriendsInfo(ALoginNames);
- end;
- //-----计算某个部门的总上线人数和总用户数-----------------------------------
- procedure TMainForm.GetBranchEmpOnlineAndSum(Branchs: TStringList; BranchInfo: TRealICQBranchInfo; var OnlineEmployee, EmployeeCount: Integer);
- var
- iLoop: Integer;
- TmpBranchInfo: TRealICQBranchInfo;
- begin
- OnlineEmployee := OnlineEmployee + BranchInfo.OnlineEmployee;
- EmployeeCount := EmployeeCount + BranchInfo.EmployeeCount;
- for iLoop := 0 to Branchs.Count - 1 do
- begin
- TmpBranchInfo := Branchs.Objects[iLoop] as TRealICQBranchInfo;
- if TmpBranchInfo.ParentID = BranchInfo.ID then
- begin
- GetBranchEmpOnlineAndSum(Branchs, TmpBranchInfo, OnlineEmployee, EmployeeCount);
- end;
- end;
- end;
- //------------------------------------------------------------------------------
-
procedure TMainForm.ShowBranchAndUsers(ExpandSelfNode: Boolean = False);
-
var
- iLoop, ItemIndex: Integer;
- OnlineEmployee, EmployeeCount: Integer;
- RealICQUser: TRealICQUser;
- RealICQContacterTreeView: TRealICQContacterTreeView;
- BranchInfo: TRealICQBranchInfo;
- Branch: TRealICQBranch;
- Employee: TRealICQEmployee;
- ParentNode: TTreeNode;
- begin
- ItemIndex := FContacterTreeViews.IndexOf(LVMyContacters);
- RealICQContacterTreeView := FContacterTreeViews.Objects[ItemIndex] as TRealICQContacterTreeView;
- RealICQContacterTreeView.OnHeadImageMouseEnter := NodeOnHeadImageMouseEnter;
- RealICQContacterTreeView.OnHeadImageMouseLeave := NodeOnHeadImageMouseLeave;
- RealICQContacterTreeView.AdjustPosition := False;
- RealICQContacterTreeView.HideSystemScrollBar;
- //pgcMainWorkArea.DisableAlign;
- { TODO -olqq -c : 添加部门和用户 2015/3/14 17:03:49 }
- { TODO -olqq -c : 需要考虑 2015/3/14 17:05:43 }
-
RealICQContacterTreeView.BeginUpdate;
- try
- {$region '添加部门'}
-
for iLoop := 0 to RealICQClient.Branchs.Count - 1 do
- begin
- BranchInfo := RealICQClient.Branchs.Objects[iLoop] as TRealICQBranchInfo;
- if (RealICQContacterTreeView.BranchItems.IndexOf(BranchInfo.ID)) >= 0 then
- Continue;
- OnlineEmployee := 0;
- EmployeeCount := 0;
- GetBranchEmpOnlineAndSum(RealICQClient.Branchs, BranchInfo, OnlineEmployee, EmployeeCount);
- Branch := TRealICQBranch.Create(BranchInfo.BranchName);
- Branch.BranchID := BranchInfo.ID;
- Branch.ParentID := BranchInfo.ParentID;
- Branch.IsGetUserList := False;
- Branch.OnlineEmployee := OnlineEmployee;
- Branch.EmployeeCount := EmployeeCount;
- RealICQContacterTreeView.AddBranch(Branch);
- end;
- // RealICQContacterTreeView.ReAlignBranchs;
- {$endregion}
- // {$region '添加联系人'}
- // for iLoop := RealICQClient.Friends.Count - 1 downto 0 do
- // begin
- // RealICQUser := RealICQClient.Friends.Objects[iLoop] as TRealICQUser;
- // if AnsiSameText(RealICQUser.LoginName, RealICQClient.LoginName) then
- // begin
- // ShowMeInformation;
- // end;
- // //if (RealICQContacterTreeView.EmployeeItems.IndexOf(RealICQUser.LoginName)) >= 0 then Continue;
- // Employee := TRealICQEmployee.Create(RealICQUser.LoginName);
- // Employee.BranchID := RealICQUser.BranchID;
- // Employee.HasEmail :=False;// (Length(Trim(RealICQUser.Email)) > 0);
- // Employee.HasAddFriend:=False;
- // if not AnsiSameText(Employee.BranchID, 'U') then
- // begin
- // RealICQContacterTreeView.AddEmployee(Employee);
- // if Assigned(Employee.Node.Parent) then
- // begin
- // UpdateEmployeeNode(Employee, RealICQUser, False);
- // end
- // else
- // begin
- // FreeAndNil(Employee);
- // if AnsiPos('-',RealICQUser.LoginName)>0 then
- // begin
- // // RealICQClient.GetUserInformation(RealICQUser.LoginName,True);
- // if (FNotAddedEmployeeList.IndexOf(RealICQUser.LoginName)) < 0 then
- // FNotAddedEmployeeList.AddObject(RealICQUser.LoginName, RealICQUser);
- // end;
- // end;
- // end
- // else
- // begin
- // if AnsiPos('-',RealICQUser.LoginName)>0 then
- // begin
- // TUsersService.GetUsersService.RequestUserInformation(RealICQUser.LoginName, RealICQClient);
- // if (FNotAddedEmployeeList.IndexOf(RealICQUser.LoginName)) < 0 then
- // FNotAddedEmployeeList.AddObject(RealICQUser.LoginName, RealICQUser);
- // end;
- // end;
- // end;
- // {$endregion}
- {
- Employee := RealICQContacterTreeView.GetEmployee(RealICQUser.LoginName);
- if Employee <> nil then
- begin
- UpdateEmployeeNode(Employee, RealICQUser, True);
- end;
- }
- {$region '展开自己所在的部门树'}
-
if ExpandSelfNode then
- begin
- Employee := RealICQContacterTreeView.GetEmployee(RealICQClient.Me.LoginName);
- ParentNode := Employee.Node.Parent;
- while ParentNode <> nil do
- begin
- ParentNode.Expanded := True;
- Branch := ParentNode.Data;
- Branch.IsGetUserList := True;
- ParentNode := ParentNode.Parent;
- end;
- RealICQContacterTreeView.MoveScrollBarToTop;
- PostMessage(RealICQContacterTreeView.Handle, WM_SIZE, 0, 0);
- end;
- {$endregion}
- finally
- RealICQContacterTreeView.EndUpdate;
- //pgcMainWorkArea.EnableAlign;
- end;
- GetOtherBranchs;
- end;
- //-------------
- procedure TMainForm.ShowBranchAndFriends;
- begin
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.RealICQClientUsersBranchReady(Sender: TObject);
- begin
-
end;
- //------------------------------------------------------------------------------
- procedure TMainForm.RealICQClientGettedFriendList(Sender: TObject);
- begin
- RealICQClient.OnGetCanSendSMSCount := Self.RealICQClientGettedCanSendSMSCount;
- lblLoginState.Caption := '载入联系人列表...';
- lblLoginState.Refresh;
- try
- if tsCustomers.Parent <> nil then
- begin
- tsCustomers.Parent := nil;
- tsCustomers.PageControl := nil;
- pgcMainWorkArea.RemoveControl(tsCustomers);
- end;
- except
- end;
- { TODO -olqq -c : 需要考虑 2015/3/14 17:06:30 }
- //读取最近的联系人列表
- try
- LoadLatests;
- except
- end;
-
- {$region '读取配置信息'}
- try
- //读取组配置信息
- LoadGroupConfigs;
- except
- DeleteFile(TRealICQClient.GetUserDir + GroupConfigXMLFile);
- LoadGroupConfigs;
- end;
- try
- //读取样式
- LoadStyleConfigs;
- except
- DeleteFile(TRealICQClient.GetUserDir + StyleConfigXMLFile);
- LoadStyleConfigs;
- end;
- try
- //读取热键设置
- LoadHotKeyConfigs;
- except
- DeleteFile(TRealICQClient.GetUserDir + HotKeyConfigXMLFile);
- LoadHotKeyConfigs;
- end;
- try
- //读取消息提示和声音配置信息
- LoadHintAndSoundConfigs;
- except
- DeleteFile(TRealICQClient.GetUserDir + HintAndSoundConfigXMLFile);
- LoadHintAndSoundConfigs;
- end;
- try
- //读取文件传输配置选项
- LoadReceiveFileConfigs;
- except
- DeleteFile(TRealICQClient.GetUserDir + ReceiveFileConfigXMLFile);
- LoadReceiveFileConfigs;
- end;
- try
- //读取安全配置选项
- LoadSafeConfigs;
- except
- DeleteFile(TRealICQClient.GetUserDir + SafeConfigXMLFile);
- LoadSafeConfigs;
- end;
- try
- //读取字体,表情等信息
- LoadInputConfigs;
- except
- DeleteFile(TRealICQClient.GetUserDir + InputConfigXMLFile);
- LoadInputConfigs;
- end;
- try
- //读取出差设置
-
LoadOfflineAutoResponseSets;
- except
- DeleteFile(TRealICQClient.GetUserDir + OfflineAutoResponseConfigXMLFile);
- LoadOfflineAutoResponseSets;
- end;
- {$endregion}
- SetFlashCaptionOnOnlineValue(False);
- FCanAlert := False;
- // ShowBranchAndUsers(True);
- try
- //重新保存组成员列表
- SaveGroupConfigs;
- except
- end;
- FCanAlert := True;
- ChangeUIColor(FUIMainColor);
- SetFlashCaptionOnOnlineValue(FFlashCaptionOnOnline);
- try
- CheckCacheDir;
- except
- end;
- try
- ShowGroupInterface;
- except
- end;
- spbShowNotReadMessage.Caption := Format('(%d)', [0]);
- RealICQClient.SendGetNewInformation(0);
- Sleep(50);
- pnlForTopMessage.Visible := False;
- RealICQClient.SendGetNewInformation(1);
- if ScrollBoxTeam.Visible or PnlMoreUser.Visible or ScrollBoxMyFriend.Visible or ScrollBoxLatests.Visible then
- else
- SetToolBarState(MyContacters);
- try
- RealICQClientReceivedAdversement(nil);
- except
- end;
- RealICQClient.SendGetMoreServerList;
- // PostMessage(Handle, WM_SIZE, 0, 0);
- //Application.ProcessMessages;
- RealICQClient.SendGetWebUrl;
- if FIsLogout then
- RealICQClient.SendGetMoreServerList;
- MainForm.RealICQClient.OnGettedAddrBookGroups := GettedAddrBookGroups;
- MainForm.RealICQClient.OnManageAddrBookResult := GettedManageAddrBookResult;
- RealICQClient.SendGetAddrBookGroup;
- // if RealICQClient.ShowMiniPage then
- // RealICQClient.SendGetNewInformation(2);
- if TCustomerConfig.GetConfig.ShowGuideView then
- btShowMiniPageClick(nil);
- try
- pgcMainWorkArea.ActivePageIndex := 0;
- except
- end;
- end;
- procedure TMainForm.TimerForGetBranchOnlineStatesTimer(Sender: TObject);
- begin
- miChangeServerClick(nil);
- TimerForGetBranchUsersOnlineStates.Enabled := False;
- TimerForGetBranchUsersOnlineStates.Enabled := True;
- end;
- procedure TMainForm.TimerForGetBranchUsersOnlineStatesTimer(Sender: TObject);
- var
- iLoop, ItemIndex: Integer;
- RealICQContacterTreeView: TRealICQContacterTreeView;
- Branch: TRealICQBranch;
- StrBranchs: string;
- begin
- TimerForGetBranchUsersOnlineStates.Enabled := False;
- ItemIndex := FContacterTreeViews.IndexOf(LVMoreUsers);
- if ItemIndex >= 0 then
- begin
- RealICQContacterTreeView := FContacterTreeViews.Objects[ItemIndex] as TRealICQContacterTreeView;
- StrBranchs := '';
- for iLoop := 0 to RealICQContacterTreeView.BranchItems.Count - 1 do
- begin
- Branch := RealICQContacterTreeView.BranchItems.Objects[iLoop] as TRealICQBranch;
- if Branch.Node.Expanded then
- begin
- StrBranchs := StrBranchs + Branch.BranchID + ',';
- end;
- end;
- miChangeServerClick(nil);
- if Length(StrBranchs) > 0 then
- RealICQClient.SendGetMoreUser(StrBranchs, FCurrentServerID);
- end;
- end;
- procedure TMainForm.btShowMiniPageClick(Sender: TObject);
- var
- AShowMiniPageSet, AShowMiniPageWhenEverLoginSet: Boolean;
- jo: ISuperObject;
- begin
- jo := SO();
- // if TConditionConfig.GetConfig.RemoteUI then
- // begin
- // jo.S['url'] := Format('%s/guideview/index.html?v=%d', [TConditionConfig.GetConfig.RemoteUIHost, GetTickCount]);
- // end
- // else
- // jo.S['url'] := ExtractFilePath(paramstr(0)) + 'html/guideview/#/';
- jo.S['caption'] := '引导页';
- jo.B['center'] := True;
- jo.B['unsizeable'] := True;
- // if not Assigned(AGuideViewForm) then
- AGuideViewForm := TGuideViewForm.Create(Self);
- AGuideViewForm.SetFormInfo(jo.AsString);
- AGuideViewForm.Show;
- // AShowMiniPageSet := RealICQClient.ShowMiniPageSet;
- // AShowMiniPageWhenEverLoginSet := RealICQClient.ShowMiniPageWhenEverLoginSet;
- // try
- // RealICQClient.ShowMiniPageSet := True;
- // RealICQClient.ShowMiniPageWhenEverLoginSet := True;
- // RealICQClientGettedMiniPageSets(nil);
- // finally
- // RealICQClient.ShowMiniPageSet := AShowMiniPageSet;
- // RealICQClient.ShowMiniPageWhenEverLoginSet := AShowMiniPageWhenEverLoginSet;
- // end;
- end;
- procedure TMainForm.RealICQClientGettedMiniPageSets(Sender: TObject);
- var
- SystemMessage: TRealICQSystemMessage;
- UserLoginName: string;
- begin
- //if (Sender <> nil) then
- if not RealICQClient.ShowMiniPageSet then
- Exit;
- SystemMessage := TRealICQSystemMessage.Create;
- SystemMessage.MessageID := 10000;
- SystemMessage.MessageType := mtAdvertisement;
- SystemMessage.AutoOpenWindow := True;
- SystemMessage.Position := mpCenter;
- SystemMessage.Left := 0;
- SystemMessage.Top := 0;
- SystemMessage.Width := 618;
- SystemMessage.Height := 465;
- SystemMessage.Delay := 0;
- SystemMessage.MaxShowTimes := 0;
- SystemMessage.Title := '每日新闻';
- SystemMessage.Content := '';
- UserLoginName := MainForm.RealICQClient.LoginName;
- if Pos('+', UserLoginName) > 0 then
- UserLoginName := Copy(UserLoginName, Pos('+', UserLoginName) + 1, Length(UserLoginName));
-
- //SystemMessage.URL := Format(MiniPageURL, [UserLoginName]);
- SystemMessage.URL := Format(RealICQClient.WebAppBaseURL + MiniPageURL, [UserLoginName]);
- SystemMessage.AutoCloseTime := 0;
- if RealICQClient.ShowMiniPageWhenEverLoginSet then
- SystemMessage.MaxShowTimes := 0
- else
- SystemMessage.MaxShowTimes := 1;
- RealICQClientReceivedSystemMessage(RealICQClient, SystemMessage);
- end;
- procedure TMainForm.RealICQClientGettedMoreBranchList(Sender: TObject);
- var
- iLoop, jLoop, ItemIndex: Integer;
- RealICQContacterTreeView: TRealICQContacterTreeView;
- BranchInfo: TRealICQBranchInfo;
- Branch, TopBranch: TRealICQBranch;
- OnlineEmployee, EmployeeCount: Integer;
- AFinded: Boolean;
- Employee: TRealICQEmployee;
- begin
- //debug('RealICQClientGettedMoreBranchList','mainform');
- AFinded := False;
- ItemIndex := FContacterTreeViews.IndexOf(LVMoreUsers);
- if ItemIndex >= 0 then
- begin
- RealICQContacterTreeView := FContacterTreeViews.Objects[ItemIndex] as TRealICQContacterTreeView;
- RealICQContacterTreeView.OnHeadImageMouseEnter := NodeOnHeadImageMouseEnter;
- RealICQContacterTreeView.OnHeadImageMouseLeave := NodeOnHeadImageMouseLeave;
- for iLoop := 0 to RealICQClient.MoreBranchs.Count - 1 do
- begin
- BranchInfo := RealICQClient.MoreBranchs.Objects[iLoop] as TRealICQBranchInfo;
- if BranchInfo.ParentID = '0' then
- begin
- for jLoop := 0 to RealICQContacterTreeView.BranchItems.Count - 1 do
- begin
- Branch := RealICQContacterTreeView.BranchItems.Objects[jLoop] as TRealICQBranch;
- if (Branch.ParentID = '0') and AnsiSameText(Branch.BranchID, BranchInfo.ID) then
- begin
- AFinded := True;
- Break;
- end;
- end;
- Break;
- end;
- end;
- if not AFinded then
- begin
- try
- RealICQContacterTreeView.Clear;
- FreeAndNil(RealICQContacterTreeView);
- FContacterTreeViews.Delete(ItemIndex);
- except
- Exit;
- end;
- end;
- end;
- if not AFinded then
- ItemIndex := AddContacterTreeView(ScrollBoxMoreUser, LVMoreUsers)
- else
- ItemIndex := FContacterTreeViews.IndexOf(LVMoreUsers);
- RealICQContacterTreeView := FContacterTreeViews.Objects[ItemIndex] as TRealICQContacterTreeView;
- RealICQContacterTreeView.OnHeadImageMouseEnter := NodeOnHeadImageMouseEnter;
- RealICQContacterTreeView.OnHeadImageMouseLeave := NodeOnHeadImageMouseLeave;
- RealICQContacterTreeView.AdjustPosition := False;
- RealICQContacterTreeView.AutoChangeOnlineNumeric := False;
- RealICQContacterTreeView.AutoCalculate := False;
- if not AFinded then
- begin
- RealICQContacterTreeView.HideSystemScrollBar;
- tsContacters.DisableAlign;
- RealICQContacterTreeView.BeginUpdate;
- end;
- try
- {$region '添加部门'}
- for iLoop := 0 to RealICQClient.MoreBranchs.Count - 1 do
- begin
- BranchInfo := RealICQClient.MoreBranchs.Objects[iLoop] as TRealICQBranchInfo;
- OnlineEmployee := 0;
- EmployeeCount := 0;
- GetBranchEmpOnlineAndSum(RealICQClient.MoreBranchs, BranchInfo, OnlineEmployee,EmployeeCount);
- if (RealICQContacterTreeView.BranchItems.IndexOf(BranchInfo.ID)) >= 0 then
- begin
- Branch := RealICQContacterTreeView.BranchItems.Objects[RealICQContacterTreeView.BranchItems.IndexOf(BranchInfo.ID)] as TRealICQBranch;
- Branch.OnlineEmployee := BranchInfo.OnlineEmployee;
- //Branch.EmployeeCount := EmployeeCount;
- Branch.EmployeeCount := BranchInfo.EmployeeCount;
- Branch.Update;
- Continue;
- end;
- //-----------------------------------------------------------------
- Branch := TRealICQBranch.Create(BranchInfo.BranchName);
- Branch.BranchID := BranchInfo.ID;
- Branch.ParentID := BranchInfo.ParentID;
- if Branch.ParentID = '0' then
- begin
- TopBranch := Branch;
- //EmployeeCount:=EmployeeCount-BranchInfo.EmployeeCount;
- if BranchInfo.EmployeeCount > 0 then
- begin
- RealICQClient.SendGetMoreUser(TopBranch.BranchID, FCurrentServerID);
- end;
- end;
- Branch.OnlineEmployee := BranchInfo.OnlineEmployee;
- //Branch.EmployeeCount:=EmployeeCount;
- Branch.EmployeeCount := BranchInfo.EmployeeCount;
- RealICQContacterTreeView.AddBranch(Branch);
- Application.ProcessMessages;
- end;
- {$endregion}
- if not AFinded then
- begin
- RealICQContacterTreeView.ReAlignBranchs;
- if Assigned(TopBranch) then
- TopBranch.Node.Expanded := True;
- PostMessage(RealICQContacterTreeView.Handle, WM_SIZE, 0, 0);
- RealICQContacterTreeView.MoveScrollBarToTop;
- end;
- finally
- if not AFinded then
- begin
- RealICQContacterTreeView.EndUpdate;
- tsContacters.EnableAlign;
- end;
- end;
- ImgLoadingMoreBranchs.Visible := False;
- ScrollBoxMoreUser.Visible := True;
- {TimerForGetBranchOnlineStates.Enabled := False;
- TimerForGetBranchOnlineStates.Enabled := True;}
- end;
- //----用户单击部门------------------------------------
- procedure TMainForm.NodeBranchClick(Sender: TObject; Branch: TRealICQBranch);
- var
- RealICQContacterTreeView: TRealICQContacterTreeView;
- ItemIndex: Integer;
- Employee: TRealICQEmployee;
- BranchInfo: TRealICQBranchInfo;
- begin
- //-------获取指定部门下的用户------------------------------------------------
- if (not Branch.IsGetUserList) then// and (FGetUsersTask.IndexOf(Branch.BranchID) < 0) then
- begin
- ItemIndex := FContacterTreeViews.IndexOf(LVMoreUsers);
- RealICQContacterTreeView := FContacterTreeViews.Objects[ItemIndex] as TRealICQContacterTreeView;
- RealICQContacterTreeView.OnHeadImageMouseEnter := NodeOnHeadImageMouseEnter;
- RealICQContacterTreeView.OnHeadImageMouseLeave := NodeOnHeadImageMouseLeave;
- // BranchInfo := MainForm.RealICQClient.MoreBranchs.Objects[MainForm.RealICQClient.MoreBranchs.IndexOf(Branch.BranchID)] as TRealICQBranchInfo;
- // FGetUsersTask.AddObject(Branch.BranchID, Branch);
- // if (BranchInfo.IsGetUserList) then
- // begin
- // //RealICQContacterTreeView.ReCalculateEmployeeCount(Branch);
- // RealICQClientGettedMoreUserList(nil)
- // end
- // else
- if RealICQContacterTreeView.EmployeeItems.IndexOf('正在下载用户') < 0 then
- begin
- Employee := TRealICQEmployee.Create('正在下载用户');
- Employee.BranchID := Branch.BranchID;
- RealICQContacterTreeView.AddEmployee(Employee);
- Branch.Node.Expanded := True;
- GetBranchUser(Branch);
- Branch.IsGetUserList := True;
- end;
- end;
- end;
- //----------------------------------------------------------------------------
-
procedure TMainForm.GetBranchUser(Branch: TRealICQBranch);
-
var
- RealICQContacterTreeView: TRealICQContacterTreeView;
- iIndex: Integer;
- begin
- //debug(Branch.BranchName,'GetBranchUser');
- SetGetMoreUserEvent;
- //iIndex := FContacterTreeViews.IndexOf(LVMoreUsers);
- //RealICQContacterTreeView := FContacterTreeViews.Objects[iIndex] as TRealICQContacterTreeView;
- //RealICQContacterTreeView.ReCalculateEmployeeCount(Branch);
-
RealICQClient.SendGetBranchs(FCurrentServerID, StrToInt(Branch.BranchID));
- Sleep(5);
- RealICQClient.SendGetMoreUser(Branch.BranchID, FCurrentServerID);
- end;
- //----------------------------------------------------------------------
- procedure TMainForm.RealICQClientGettedMoreUserList(Sender: TObject);
- var
- iLoop, ItemIndex: Integer;
- RealICQUser: TRealICQUser;
- RealICQContacterTreeView: TRealICQContacterTreeView;
- Employee: TRealICQEmployee;
- TmpBranch, Branch, TopBranch: TRealICQBranch;
- ParentNode: TTreeNode;
- BranchInfo: TRealICQBranchInfo;
- begin
- TmpBranch := nil;
- ItemIndex := FContacterTreeViews.IndexOf(LVMoreUsers);
- RealICQContacterTreeView := FContacterTreeViews.Objects[ItemIndex] as TRealICQContacterTreeView;
- RealICQContacterTreeView.AdjustPosition := False;
- RealICQContacterTreeView.HideSystemScrollBar;
- RealICQContacterTreeView.AutoChangeOnlineNumeric := True;
- RealICQContacterTreeView.OnItemOnline := nil;
- RealICQContacterTreeView.OnItemOffline := nil;
- tsContacters.DisableAlign;
- RealICQContacterTreeView.BeginUpdate;
- try
- ItemIndex := RealICQContacterTreeView.EmployeeItems.IndexOf('正在下载用户');
- if ItemIndex >= 0 then
- begin
- Employee := RealICQContacterTreeView.GetEmployee('正在下载用户');
- ParentNode := Employee.Node.Parent;
- TmpBranch := TRealICQBranch(ParentNode.Data);
- TmpBranch.IsGetUserList := True;
- RealICQContacterTreeView.EmployeeItems.Delete(ItemIndex);
- end;
- {$region '添加联系人'}
-
for iLoop := RealICQClient.MoreUsers.Count - 1 downto 0 do
- begin
- RealICQUser := RealICQClient.MoreUsers.Objects[iLoop] as TRealICQUser;
- ItemIndex := RealICQContacterTreeView.BranchItems.IndexOf(RealICQUser.BranchID);
- if ItemIndex < 0 then
- Continue;
- ItemIndex := RealICQContacterTreeView.EmployeeItems.IndexOf(RealICQUser.LoginName);
- if ItemIndex >= 0 then
- RealICQContacterTreeView.EmployeeItems.Delete(ItemIndex);
- Employee := TRealICQEmployee.Create(RealICQUser.LoginName);
- Employee.BranchID := RealICQUser.BranchID; //很重要
- RealICQContacterTreeView.AddEmployee(Employee);
- //UpdateEmployeeNode(Employee, RealICQUser, False);
- TUsersService.GetUsersService.UpdateTreeNode(RealICQContacterTreeView, Employee, RealICQUser);
- end;
- {$endregion}
- {$region '添加部门'}
-
for iLoop := RealICQClient.MoreBranchs2.Count - 1 downto 0 do
- begin
- BranchInfo := RealICQClient.MoreBranchs2.Objects[iLoop] as TRealICQBranchInfo;
- if (RealICQContacterTreeView.BranchItems.IndexOf(BranchInfo.ID)) >= 0 then
- begin
- Branch := RealICQContacterTreeView.BranchItems.Objects[RealICQContacterTreeView.BranchItems.IndexOf(BranchInfo.ID)] as TRealICQBranch;
- Branch.OnlineEmployee := BranchInfo.OnlineEmployee;
- Branch.EmployeeCount := BranchInfo.EmployeeCount;
- Branch.Update;
- Continue;
- end;
- Branch := TRealICQBranch.Create(BranchInfo.BranchName);
- Branch.BranchID := BranchInfo.ID;
- Branch.ParentID := BranchInfo.ParentID;
- if Branch.ParentID = '0' then
- begin
- TopBranch := Branch;
- if BranchInfo.EmployeeCount > 0 then
- begin
- RealICQClient.SendGetMoreUser(TopBranch.BranchID, FCurrentServerID);
- end;
- end;
- Branch.OnlineEmployee := BranchInfo.OnlineEmployee;
- Branch.EmployeeCount := BranchInfo.EmployeeCount;
- RealICQContacterTreeView.AddBranch(Branch);
- Application.ProcessMessages;
- end;
- {$endregion}
-
// PostMessage(RealICQContacterTreeView.Handle, WM_SIZE, 0, 0);
- finally
- RealICQContacterTreeView.EndUpdate;
- if TmpBranch <> nil then
- begin
- PostMessage(RealICQContacterTreeView.Handle, WM_SIZE, 0, 0);
- Debug(TmpBranch.BranchName, '添加全市用户列表');
- TmpBranch.Node.Expanded := True;
- end;
- tsContacters.EnableAlign;
- end;
- end;
- //-------------------桌面备份---------------------------------------------------
- procedure TMainForm.RealICQClientGettedPermission(Sender: TObject);
- begin
- spbNetworkBackup.Visible := RealICQClient.UserPermission.EnableBackup;
- end;
- //----------------------------------------------------------------------
- procedure TMainForm.RealICQClientGettedRemoteControlTransmiteBeControlResponse(Sender: TObject; ALoginName: string; AAcceptted: Boolean);
- var
- TalkingForm: TTalkingForm;
- begin
- TalkingForm := GetTalkingForm(ALoginName, Sender as TRealICQClient);
- if TalkingForm = nil then
- Exit;
- if TalkingForm.CanWriteMessage then
- TalkingForm.ShowGettedRemoteControlTransmiteControlBeControlResponse(AAcceptted);
- end;
- procedure TMainForm.RealICQClientGettedRemoteControlTransmiteConnectted(Sender: TObject; ALoginName: string);
- var
- TalkingForm: TTalkingForm;
- begin
- TalkingForm := GetTalkingForm(ALoginName, Sender as TRealICQClient);
- if TalkingForm = nil then
- Exit;
- if TalkingForm.CanWriteMessage then
- TalkingForm.ShowGettedRemoteControlTransmiteConnectted;
- end;
- procedure TMainForm.RealICQClientGettedRemoteControlTransmiteControlRequest(Sender: TObject; ALoginName: string);
- var
- TalkingForm: TTalkingForm;
- begin
- TalkingForm := GetTalkingForm(ALoginName, Sender as TRealICQClient);
- if TalkingForm = nil then
- Exit;
- if TalkingForm.CanWriteMessage then
- TalkingForm.ShowGettedRemoteControlTransmiteControlRequest;
- end;
- procedure TMainForm.RealICQClientGettedRemoteControlTransmiteControlResponse(Sender: TObject; ALoginName: string; AAcceptted: Boolean);
- var
- TalkingForm: TTalkingForm;
- begin
- TalkingForm := GetTalkingForm(ALoginName, Sender as TRealICQClient);
- if TalkingForm = nil then
- Exit;
- if TalkingForm.CanWriteMessage then
- TalkingForm.ShowGettedRemoteControlTransmiteControlControlResponse(AAcceptted);
- end;
- procedure TMainForm.RealICQClientGettedRemoteControlTransmiteRequest(Sender: TObject; ALoginName: string);
- var
- AShowActive: Boolean;
- TalkingForm: TTalkingForm;
- iWaitTimes: Integer;
- begin
- AShowActive := (RealICQClient.IsAutoState = True) and (RealICQClient.Me.LoginState = stLeave) and AnsiSameText(RealICQClient.Me.LeaveMessage, '忙碌');
- TalkingForm := GetTalkingForm(ALoginName, Sender as TRealICQClient);
- if TalkingForm = nil then
- begin
- TalkingForm := OpenTalkingForm(ALoginName, not AShowActive, Sender as TRealICQClient);
- end;
- iWaitTimes := 0;
- while not TalkingForm.CanWriteMessage do
- begin
- Application.ProcessMessages;
- Inc(iWaitTimes);
- if iWaitTimes > 1000 then
- break;
- Sleep(10);
- end;
- if (GetForegroundWindow <> TalkingForm.Handle) then
- begin
- FlashWindow(TalkingForm.Handle, True);
- if PlaySoundOnGetMessage then
- PlayEventSound(FMessageEventSound);
- end;
- TalkingForm.ShowGettedRemoteControlTransmiteRequest;
- end;
- procedure TMainForm.RealICQClientGettedRemoteControlTransmiteResponse(Sender: TObject; ALoginName: string; AAcceptted: Boolean);
- var
- TalkingForm: TTalkingForm;
- begin
- TalkingForm := GetTalkingForm(ALoginName, Sender as TRealICQClient);
- if TalkingForm = nil then
- Exit;
- if TalkingForm.CanWriteMessage then
- TalkingForm.ShowGettedRemoteControlTransmiteResponse(AAcceptted);
- end;
- procedure TMainForm.RealICQClientGettedRemoteControlTransmiteScreenImage(Sender: TObject; ALoginName: string; ALeft, ATop, AWidth, AHeight: Integer; AP: TPoint; ABitmap: TBitmap);
- begin
- if RemoteControlForm = nil then
- Exit;
- RemoteControlForm.imgRCScreen.Picture.Bitmap.Canvas.CopyRect(Rect(ALeft, ATop, ALeft + AWidth, ATop + AHeight), ABitmap.canvas, Rect(0, 0, ABitmap.width, ABitmap.height)); //拷贝
- end;
- procedure TMainForm.RealICQClientGettedRemoteControlTransmiteScreenSize(Sender: TObject; ALoginName: string; AWidth, AHeight: Integer);
- var
- TalkingForm: TTalkingForm;
- begin
- TalkingForm := GetTalkingForm(ALoginName, Sender as TRealICQClient);
- if TalkingForm = nil then
- Exit;
- TalkingForm.ShowGettedRemoteControlTransmiteRecvedScreenSize(AWidth, AHeight);
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.CheckCacheDir;
- var
- DSearchRec: TSearchRec;
- FindResult: Integer;
- begin
- FindResult := FindFirst(CacheDir + '*' + CacheFileExt, faAnyFile, DSearchRec);
- while FindResult = 0 do
- begin
- if (DSearchRec.Name <> '.') and (DSearchRec.Name <> '..') then
- begin
- try
- if Date - StrToDateTime(GetFileTimeInfo(CacheDir + ExtractFileName(DSearchRec.Name), 2)) > AudoDeleteCacheFileDate then
- DeleteFile(CacheDir + ExtractFileName(DSearchRec.Name));
- except
- if Date - StrToDateTime(AnsiReplaceStr(GetFileTimeInfo(CacheDir + ExtractFileName(DSearchRec.Name), 2), '-', '/')) > AudoDeleteCacheFileDate then
- DeleteFile(CacheDir + ExtractFileName(DSearchRec.Name));
- end;
- end;
- FindResult := FindNext(DSearchRec);
- end;
- FindResult := FindFirst(CacheDir + '*' + CacheResumeSizeFileExt, faAnyFile, DSearchRec);
- while FindResult = 0 do
- begin
- if (DSearchRec.Name <> '.') and (DSearchRec.Name <> '..') then
- begin
- try
- if Date - StrToDateTime(GetFileTimeInfo(CacheDir + ExtractFileName(DSearchRec.Name), 2)) > AudoDeleteCacheFileDate then
- DeleteFile(CacheDir + ExtractFileName(DSearchRec.Name));
- except
- if Date - StrToDateTime(AnsiReplaceStr(GetFileTimeInfo(CacheDir + ExtractFileName(DSearchRec.Name), 2), '-', '/')) > AudoDeleteCacheFileDate then
- DeleteFile(CacheDir + ExtractFileName(DSearchRec.Name));
- end;
- end;
- FindResult := FindNext(DSearchRec);
- end;
- if GetDirectorySize(CacheDir) > MaxCacheDirSize * 1024 * 1024 then
- begin
- if MessageBox(Handle, PChar('Cache目录的大小已经超过 ' + IntToStr(MaxCacheDirSize) + 'MB，是否打开Cache目录进行管理？'), '提示', MB_ICONINFORMATION or MB_OKCANCEL) = ID_OK then
- WinExec(PChar('explorer "' + CacheDir + '"'), SW_SHOWNORMAL);
- end;
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.ShowWebTabs;
- var
- iLoop: Integer;
- TabSheet: TTabSheet;
- Bitmap: TBitmap;
- WebPanel: TWebPanel;
- EUser, EPass: string;
- begin
- //先删除
- try
- for iLoop := 0 to FWebTabs.Count - 1 do
- begin
- TabSheet := FWebTabs[iLoop];
- TabSheet.OnShow := nil;
- TabSheet.PageControl := nil;
- FreeAndNil(TabSheet);
- end;
- except
- end;
- FWebTabs.Clear;
- //显示
- pgcMainWorkArea.DisableAlign;
- try
- for iLoop := 0 to FWebPanels.Count - 1 do
- begin
- WebPanel := FWebPanels.Objects[iLoop] as TWebPanel;
- if (not WebPanel.Show) and (not WebPanel.MustShow) then
- Continue;
- if ((AnsiPos('邮件', WebPanel.FName) > 0) or (AnsiPos('邮箱', WebPanel.FName) > 0) or (AnsiPos('信箱', WebPanel.FName) > 0)) and (WebPanel.MustShow) then
- begin
- if WebPanel.UserIMLoginName then
- EUser := RealICQClient.LoginName
- else
- EUser := WebPanel.CustomLoginName;
- if WebPanel.UserIMPassword then
- EPass := RealICQClient.Password
- else
- EPass := WebPanel.CustomPassword;
- //WebBrowserForEMail.Navigate(Format('http://mail.lishui.gov.cn/web_email/modules/i_login.phtml?field_ouser=%s&field_ovdomain=%s&field_opass=%s', [EUser, 'lishui.gov.cn', EPass]));
- end;
- TabSheet := TTabSheet.Create(pgcMainWorkArea);
- TabSheet.Parent := pgcMainWorkArea;
- TabSheet.DoubleBuffered := True;
- TabSheet.Caption := WebPanel.Name;
- TabSheet.ShowHint := False;
- if FileExists(WebPanel.Image) then
- begin
- Bitmap := GetSamllBitmap(WebPanel.Image, 32, 32, False);
- try
- try
- Bitmap.LoadFromFile(WebPanel.Image);
- Bitmap.SetSize(ImgLstPageControl.Width, ImgLstPageControl.Height);
- ImgLstPageControl.Add(Bitmap, nil);
- TabSheet.ImageIndex := ImgLstPageControl.Count - 1;
- except
- //
- end;
- finally
- FreeAndNil(Bitmap);
- end;
- end
- else
- TabSheet.ImageIndex := 2; //?号图标
- TabSheet.OnShow := WebTabShow;
- TabSheet.Tag := iLoop;
- TabSheet.PageControl := pgcMainWorkArea;
- FWebTabs.Add(TabSheet);
- end;
- finally
- pgcMainWorkArea.EnableAlign;
- end;
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.RealICQClientGetWebTabs(Sender: TObject; ATabCount: Integer; WebTabRecords: array of TWebTabRecord);
- var
- iLoop, jLoop: Integer;
- WebTabRecord: TWebTabRecord;
- WebPanel: TWebPanel;
- FFinded: Boolean;
- AWebPanels: TStringList;
- begin
- LoadWebPanelsFromXML;
- AWebPanels := TStringList.Create;
- for iLoop := 0 to FWebPanels.Count - 1 do
- begin
- WebPanel := FWebPanels.Objects[iLoop] as TWebPanel;
- AWebPanels.AddObject(WebPanel.ID, WebPanel);
- end;
- FWebPanels.Clear;
- for iLoop := Low(WebTabRecords) to High(WebTabRecords) do
- begin
- WebTabRecord := WebTabRecords[iLoop];
- if AWebPanels.IndexOf(WebTabRecord.ID) < 0 then
- begin
- WebPanel := TWebPanel.Create;
- //FWebPanels.AddObject(WebTabRecord.Name, WebPanel);
- WebPanel.FUserIMLoginName := True;
- WebPanel.FUserIMPassword := True;
- WebPanel.FCustomLoginName := '';
- WebPanel.FCustomPassword := '';
- WebPanel.FShow := False;
- end
- else
- begin
- WebPanel := AWebPanels.Objects[AWebPanels.IndexOf(WebTabRecord.ID)] as TWebPanel;
- end;
- WebPanel.MustShow := WebTabRecord.MustShow;
- if WebPanel.MustShow then
- WebPanel.FShow := True;
- WebPanel.FID := WebTabRecord.ID;
- WebPanel.FName := WebTabRecord.Name;
- WebPanel.FURL := WebTabRecord.URL;
- WebPanel.FImage := WebTabRecord.IconFile;
- WebPanel.Content := WebTabRecord.Content;
- if AnsiSameText(WebTabRecord.Method, 'GET') then
- WebPanel.FNavigateType := ntGET
- else if AnsiSameText(WebTabRecord.Method, 'POST') then
- WebPanel.FNavigateType := ntPOST
- else
- WebPanel.FNavigateType := ntFill;
- WebPanel.FPostFields := WebTabRecord.PostFields;
- FWebPanels.AddObject(WebPanel.FID, WebPanel);
- end;
- {for iLoop := FWebPanels.Count - 1 downto 0 do
- begin
- WebPanel := FWebPanels.Objects[iLoop] as TWebPanel;
- //if WebPanel.MustShow then
- begin
- FFinded := False;
- for jLoop := Low(WebTabRecords) to High(WebTabRecords) do
- begin
- WebTabRecord := WebTabRecords[jLoop];
- if AnsiSameStr(WebTabRecord.ID, WebPanel.ID) then
- begin
- FFinded := True;
- Break;
- end;
- end;
-
- if not FFinded then
- begin
- FreeAndNil(WebPanel);
- FWebPanels.Delete(iLoop);
- end;
- end;
- end; }
- SaveWebPanelsToXML;
- DisplayWebs := False;
- ShowWebTabs;
- DisplayWebs := True;
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.RealICQClientInputting(Sender: TObject; ALoginName: string; AInputting: Boolean);
- var
- TalkingForm: TTalkingForm;
- begin
- TalkingForm := GetTalkingForm(ALoginName, Sender as TRealICQClient);
- if TalkingForm = nil then
- Exit;
- TalkingForm.ShowInputting(AInputting);
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.RealICQClientJoinedTeam(Sender: TObject; ARealICQTeam: TRealICQTeam);
- var
- AlertMessage: string;
- RealICQUser: TRealICQUser;
- begin
- RealICQUser := TUsersService.GetUsersService.GetOrRequestUser(ARealICQTeam.TeamCreater);
- if RealICQUser.DisplayName = '' then
- AlertMessage := RealICQUser.LoginName
- else
- AlertMessage := RealICQUser.DisplayName;
- if ARealICQTeam.IsTempTeam then
- AlertMessage := AlertMessage + ' 将您添加进了 临时多人会话'
- else
- AlertMessage := AlertMessage + ' 将您添加进了群组: ' + ARealICQTeam.TeamCaption;
- ShowNotifyAlertForm(AlertMessage);
- AddMessageHistory(smSimple, AlertMessage, nil);
- UpdateTeamTalkingForm(ARealICQTeam);
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.RealICQClientJoinTeamRequest(Sender: TObject; ARealICQTeam: TRealICQTeam; ALoginName, ATag: string);
- begin
- AddMessageHistory(smSimple, Format('%s 请求加入群组 %s<%s>。', [ALoginName, ARealICQTeam.TeamCaption, ARealICQTeam.TeamID]), nil);
- ShowJoinTeamRequestWindow(Self, ARealICQTeam.TeamID, ARealICQTeam.TeamCaption, ALoginName, ATag);
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.RealICQClientJoinTeamResponse(Sender: TObject; ATeamID: string; ALoginName: string; ATag: string; AAcceptted: Boolean);
- var
- ATeam: TRealICQTeam;
- begin
- ATeam := TTeamsAdapter.GetTeam(ATeamID);
- if ATeam = nil then
- Exit;
- if AAcceptted then
- begin
- AddMessageHistory(smSimple, ALoginName + ' 接受了您加入群组 ' + ATeam.TeamCaption + ' 的请求', nil);
- ShowNotifyAlertForm(ALoginName + ' 接受您加入群组 ' + ATeam.TeamCaption + ' 的请求');
- end
- else
- begin
- if Length(ATag) = 0 then
- ATag := '无';
- AddMessageHistory(smSimple, ALoginName + ' 拒绝您加入群组 ' + ATeam.TeamCaption, nil);
- ShowNotifyAlertForm(ALoginName + ' 拒绝您加入群组 ' + ATeam.TeamCaption + #$D#$A + '附言 ：' + ATag);
- end;
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.RealICQClientTeamDisbanded(Sender: TObject; ARealICQTeam: TRealICQTeam);
- var
- iIndex: Integer;
- AlertMessage: string;
- RealICQUser: TRealICQUser;
- begin
- iIndex := FLVTeams.Items.IndexOf(ARealICQTeam.TeamID);
- if iIndex >= 0 then
- begin
- FLVTeams.Items.Delete(iIndex);
- RealICQUser := TUsersService.GetUsersService.GetOrRequestUser(ARealICQTeam.TeamCreater);
- if RealICQUser = RealICQClient.Me then
- AlertMessage := '您'
- else if RealICQUser.DisplayName = '' then
- AlertMessage := RealICQUser.LoginName
- else
- AlertMessage := RealICQUser.DisplayName;
- if ARealICQTeam.IsTempTeam then
- AlertMessage := AlertMessage + ' 解散了 多人对话'
- else
- AlertMessage := AlertMessage + ' 解散了群组: ' + ARealICQTeam.TeamCaption;
- ShowNotifyAlertForm(AlertMessage);
- AddMessageHistory(smSimple, AlertMessage, nil);
- CloseTeamOptionsForm(ARealICQTeam.TeamID);
- CloseJoinTeamRequestWindow(ARealICQTeam.TeamID);
- UpdateTeamTalkingForm(ARealICQTeam);
- end;
- end;
- procedure TMainForm.RealICQClientTeamQuitted(Sender: TObject; ARealICQTeam: TRealICQTeam; ALoginName: string);
- var
- iIndex: Integer;
- AlertMessage: string;
- begin
- iIndex := FLVTeams.Items.IndexOf(ARealICQTeam.TeamID);
- if iIndex >= 0 then
- begin
- FLVTeams.Items.Delete(iIndex);
- if ARealICQTeam.IsTempTeam then
- AlertMessage := '您 退出了 多人对话'
- else
- AlertMessage := '您 退出了群组: ' + ARealICQTeam.TeamCaption;
- ShowNotifyAlertForm(AlertMessage);
- AddMessageHistory(smSimple, AlertMessage, nil);
- CloseTeamOptionsForm(ARealICQTeam.TeamID);
- CloseJoinTeamRequestWindow(ARealICQTeam.TeamID);
- UpdateTeamTalkingForm(ARealICQTeam);
- end;
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.SetFlashCaptionOnOnlineValue(Value: Boolean);
- var
- iLoop: Integer;
- GroupName: string;
- RealICQContacterListView: TRealICQContacterListView;
- RealICQContacterTreeView: TRealICQContacterTreeView;
- begin
- for iLoop := 0 to FContacterListViews.Count - 1 do
- begin
- GroupName := FContacterListViews[iLoop];
- RealICQContacterListView := FContacterListViews.Objects[iLoop] as TRealICQContacterListView;
- RealICQContacterListView.FlashCaptionOnOnline := Value and (GroupName <> LVStrangers) and (GroupName <> LVBlacklists) and (GroupName <> LVLatests);
- end;
- for iLoop := 0 to FContacterTreeViews.Count - 1 do
- begin
- RealICQContacterTreeView := FContacterTreeViews.Objects[iLoop] as TRealICQContacterTreeView;
- RealICQContacterTreeView.FlashCaptionOnOnline := Value;
- RealICQContacterTreeView.ReDrawAll;
- end;
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.RealICQClientUserExInformationChanged(Sender: TObject; RealICQUser: TRealICQUser);
- begin
- if (OptionsForm <> nil) and (RealICQUser = RealICQClient.Me) then
- begin
- OptionsForm.GetSets;
- end;
- UpdateSeeInformationForm(RealICQUser);
- UpdateTalkingForm(RealICQUser);
- UpdateSMSForm(RealICQUser);
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.RealICQClientUserInformationReady(Sender: TObject; RealICQUser: TRealICQUser);
- var
- ItemIndex: Integer;
- RealICQContacterListItem: TRealICQContacterListItem;
- RealICQContacterListView: TRealICQContacterListView;
- RealICQFriendTreeView: TRealICQContacterTreeView;
- RealICQContacterTreeView: TRealICQContacterTreeView;
- Employee: TRealICQEmployee;
- Friend: TRealICQEmployee;
- iIndex, iLoop, jLoop: Integer;
- GroupName: string;
- GroupMembers: TStringList;
- begin
- if UserCardForm <> nil then
- begin
- if AnsiSameText(UserCardForm.LoginName, RealICQUser.LoginName) then
- UserCardForm.LoginName := RealICQUser.LoginName;
- end;
- {$region '如果正处于过滤用户的状态,则同时也更新FSearchListView中的数据'}
- if FSearchListViewInVisible then
- begin
- ItemIndex := FSearchListView.Items.IndexOf(RealICQUser.LoginName);
- if ItemIndex >= 0 then
- begin
- RealICQContacterListItem := FSearchListView.Items.Objects[ItemIndex] as TRealICQContacterListItem;
- //BindUserDataToItem(RealICQContacterListItem, RealICQUser);
- TUsersService.GetUsersService.UpdateListItem(FSearchListView, RealICQContacterListItem, RealICQUser);
- end;
- end;
- {$endregion}
- {$region '更新“最近联系人列表”中的数据'}
-
ItemIndex := FLVLatests.Items.IndexOf(RealICQUser.LoginName);
- if ItemIndex >= 0 then
- begin
- RealICQContacterListItem := FLVLatests.Items.Objects[ItemIndex] as TRealICQContacterListItem;
- //BindUserDataToItem(RealICQContacterListItem, RealICQUser);
- TUsersService.GetUsersService.UpdateListItem(FLVLatests, RealICQContacterListItem, RealICQUser);
- end;
- {$endregion}
-
{$region 'wmCorporation工作模式或采用了树型方式组织好友列表'}
-
if TUsersService.GetUsersService.IsWorkmateOrFriend(RealICQUser.LoginName) then
- begin
- if AnsiSameText(RealICQUser.LoginName, RealICQClient.LoginName) then
- ShowMeInformation;
- ItemIndex := FContacterTreeViews.IndexOf(LVMyContacters);
- RealICQContacterTreeView := FContacterTreeViews.Objects[ItemIndex] as TRealICQContacterTreeView;
- RealICQContacterTreeView.OnHeadImageMouseEnter := NodeOnHeadImageMouseEnter;
- RealICQContacterTreeView.OnHeadImageMouseLeave := NodeOnHeadImageMouseLeave;
- Employee := RealICQContacterTreeView.GetEmployee(RealICQUser.LoginName);
- if Employee <> nil then
- //UpdateEmployeeNode(Employee, RealICQUser, True);
- TUsersService.GetUsersService.UpdateTreeNode(RealICQContacterTreeView, Employee, RealICQUser);
- ItemIndex := FContacterTreeViews.IndexOf(LvFriends);
- RealICQFriendTreeView := FContacterTreeViews.Objects[ItemIndex] as TRealICQContacterTreeView;
- Friend := RealICQFriendTreeView.GetEmployee(RealICQUser.LoginName);
- if Friend <> nil then
- //UpdateFriendNode(Friend, RealICQUser, True);
- TUsersService.GetUsersService.UpdateTreeNode(RealICQFriendTreeView, Friend, RealICQUser);
- {$region '更新自定义组中的信息'}
- if RealICQClient.WorkingMode = wmCorporation then
- begin
- for iLoop := 0 to FGroups.Count - 1 do
- begin
- GroupName := FGroups[iLoop];
- GroupMembers := FGroups.Objects[iLoop] as TStringList;
- for jLoop := 0 to GroupMembers.Count - 1 do
- begin
- if AnsiSameText(GroupMembers[jLoop], RealICQClient.LoginName) then
- begin
- iIndex := FContacterListViews.IndexOf(GroupName);
- if iIndex >= 0 then
- begin
- RealICQContacterListView := FContacterListViews.Objects[iIndex] as TRealICQContacterListView;
- if RealICQContacterListView.Items.IndexOf(RealICQClient.LoginName) = -1 then
- RealICQContacterListView.Items.Add(RealICQClient.LoginName);
- ItemIndex := RealICQContacterListView.Items.IndexOf(RealICQUser.LoginName);
- if ItemIndex >= 0 then
- begin
- RealICQContacterListItem := RealICQContacterListView.Items.Objects[ItemIndex] as TRealICQContacterListItem;
- //BindUserDataToItem(RealICQContacterListItem, RealICQUser);
- TUsersService.GetUsersService.UpdateListItem(RealICQContacterListView, RealICQContacterListItem, RealICQUser);
- end;
- end; //if
-
end; //if
-
end; //for jLoop
-
end; //for iLoop
- {$endregion}
-
end;
- {$endregion}
-
end;
- {$region '更新“全市”中的数据'}
- if RealICQClient.MoreUsers.IndexOf(RealICQUser.LoginName) >= 0 then
- begin
- ItemIndex := FContacterTreeViews.IndexOf(LVMoreUsers);
- RealICQContacterTreeView := FContacterTreeViews.Objects[ItemIndex] as TRealICQContacterTreeView;
- RealICQContacterTreeView.OnHeadImageMouseEnter := NodeOnHeadImageMouseEnter;
- RealICQContacterTreeView.OnHeadImageMouseLeave := NodeOnHeadImageMouseLeave;
- RealICQContacterTreeView.OnItemOnline := nil;
- RealICQContacterTreeView.OnItemOffline := nil;
- RealICQContacterTreeView.AutoChangeOnlineNumeric := True;
- Employee := RealICQContacterTreeView.GetEmployee(RealICQUser.LoginName);
- if Employee <> nil then
- //UpdateEmployeeNode(Employee, RealICQUser, True);
- TUsersService.GetUsersService.UpdateTreeNode(RealICQContacterTreeView, Employee, RealICQUser);
- end;
- {$endregion}
- UpdateSeeInformationForm(RealICQUser);
-
UpdateTalkingForm(RealICQUser);
- //debug('8','RealICQClientUserInformationReady');
- UpdateSMSForm(RealICQUser);
- UpdateMemberInfoOfTeamOptionsForm(RealICQUser);
- UpdateAddrBookInfo(RealICQUser);
- end;
- procedure TMainForm.UpdateAddrBookInfo(RealICQUser: TRealICQUser);
- var
- iLoop, ItemIndex: Integer;
- Employee: TRealICQEmployee;
- TmpRealICQUser: TRealICQUser;
- RealICQContacterTreeView: TRealICQContacterTreeView;
- begin
- ItemIndex := MainForm.ContacterTreeViews.IndexOf(LVAddrBook);
- if ItemIndex < 0 then
- Exit;
- RealICQContacterTreeView := MainForm.ContacterTreeViews.Objects[ItemIndex] as TRealICQContacterTreeView;
- Employee := RealICQContacterTreeView.GetEmployee(RealICQUser.LoginName);
- if (Employee <> nil) then
- begin
- Employee.Mobile := RealICQUser.Mobile;
- Employee.SMSHint := RealICQUser.Mobile;
- Employee.Tel := RealICQUser.Tel;
- Employee.Update;
- end
- else
- Exit;
- ItemIndex := MainForm.RealICQClient.AddrBookUsers.IndexOf(RealICQUser.LoginName);
- if ItemIndex < 0 then
- Exit;
- TmpRealICQUser := MainForm.RealICQClient.AddrBookUsers.Objects[ItemIndex] as TRealICQUser;
- TmpRealICQUser.Mobile := RealICQUser.Mobile;
- TmpRealICQUser.Tel := RealICQUser.Tel;
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.ShowNetWorkDiskSpaceInfo;
- begin
- lblNDSpaceSize.Caption := Format('%0fM/%dM', [RealICQNetWorkDiskClient.UsedSpaceSize / (1024 * 1024), RealICQNetWorkDiskClient.MaxSpaceSize div (1024 * 1024)]);
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.RealICQNetWorkDiskClientConnectStateChanged(Sender: TObject);
- begin
- if tsNetWorkDisk.Parent = nil then
- Exit;
- try
- FConfirmReplaceResult := -1;
- if RealICQNetWorkDiskClient.Connectting then
- begin
- lblNDState.Caption := '正在连接...';
- lblNDSpaceSize.Caption := '';
- end
- else if RealICQNetWorkDiskClient.Connected then
- begin
- lblNDState.Caption := '已连接';
- ShowNetWorkDiskSpaceInfo;
- end
- else
- begin
- lblNDState.Caption := '连接已断开';
- lblNDSpaceSize.Caption := '';
- try
- if FLVNetWorkDisk <> nil then
- begin
- FLVNetWorkDisk.Items.Clear;
- FLVNetWorkDisk.ReDrawAll;
- end;
- except
- end;
- try
- spbNDCancelAllClick(spbNDCancelAll);
- except
- end;
- end;
- spbNDMoveUp.Enabled := RealICQNetWorkDiskClient.Connected;
- spbNDRefresh.Enabled := spbNDMoveUp.Enabled;
- spbNDNewDir.Enabled := spbNDMoveUp.Enabled;
- spbNDDelete.Enabled := spbNDMoveUp.Enabled;
- shpNDDirBorder.Enabled := spbNDMoveUp.Enabled;
- edNDDir.Enabled := spbNDMoveUp.Enabled;
- spbNDUpload.Enabled := spbNDMoveUp.Enabled;
- spbNDDownload.Enabled := spbNDMoveUp.Enabled;
- spbNDCancelAll.Enabled := pnlNDMissions.Visible;
- spbNDConnect.Enabled := (not RealICQNetWorkDiskClient.Connected) and (not RealICQNetWorkDiskClient.Connectting) and (RealICQClient.Connected);
- spbNDDisconnect.Enabled := not spbNDConnect.Enabled and not RealICQNetWorkDiskClient.Connectting;
- if not edNDDir.Enabled then
- edNDDir.Text := '';
- except
- end;
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.ItemShowHint(Sender: TObject; Item: TRealICQContacterListItem; var HintStr: string);
- var
- AFile: TRealICQNetWorkDiskFile;
- ADirectory: TRealICQNetWorkDiskDirectory;
- AUploadMission: TUploadMission;
- ADownloadMission: TDownloadMission;
- begin
- if Item = nil then
- Exit;
- if Sender = FLVNetWorkDisk then
- begin
- if Copy(Item.LoginName, 1, 1) = 'D' then
- begin
- ADirectory := TRealICQNetWorkDiskDirectory(Item.Data);
- HintStr := '目录名称: ' + Trim(ADirectory.Name) + #$D#$A;
- HintStr := HintStr + '创建时间: ' + DateTimeToStr(ADirectory.CreateDate);
- end
- else if Copy(Item.LoginName, 1, 1) = 'F' then
- begin
- AFile := TRealICQNetWorkDiskFile(Item.Data);
- HintStr := '文件名称: ' + Trim(AFile.Name) + #$D#$A;
- HintStr := HintStr + '创建时间: ' + Trim(DateTimeToStr(AFile.CreateDate)) + #$D#$A;
- HintStr := HintStr + '修改时间: ' + Trim(DateTimeToStr(AFile.ModifyDate)) + #$D#$A;
- HintStr := HintStr + '大小: ' + Trim(Item.Watchword);
- end;
- end;
- if Sender = FLVNetWorkDiskUploadingFiles then
- begin
- if AnsiSameText(HintStr, '取消') then
- Exit;
- AUploadMission := TUploadMission(Item.Data);
- HintStr := AUploadMission.Name;
- end;
- if Sender = FLVNetWorkDiskDownloadingFiles then
- begin
- if AnsiSameText(HintStr, '取消') then
- Exit;
- ADownloadMission := TDownloadMission(Item.Data);
- if ADownloadMission.FDownloadMissionType = mtDir then
- HintStr := ADownloadMission.DirectoryName
- else
- HintStr := ADownloadMission.FileName;
- end;
- end;
- procedure TMainForm.LblHintClick(Sender: TObject);
- var
- FAutoSaveMessage: Boolean;
- begin
- FAutoSaveMessage := AutoSaveMessage;
- AutoSaveMessage := False;
- try
- RealICQClientReceivedSystemMessage(RealICQClient, FTopSystemMessage);
- finally
- btCloseTopMessageClick(nil);
- AutoSaveMessage := FAutoSaveMessage;
- end;
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.NDSelectItemChanged(Item: TRealICQContacterListItem);
- begin
- if not pnlNDMissions.Visible then
- begin
- spbNDDelete.Enabled := (FLVNetWorkDisk <> nil) and (FLVNetWorkDisk.SelCount > 0);
- spbNDDownload.Enabled := spbNDDelete.Enabled;
- end;
- spbNDCancelAll.Enabled := pnlNDMissions.Visible;
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.NDItemMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
- begin
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.NDMissionItemIconButtonClick(Sender: TObject; Item: TRealICQContacterListItem; IconButtonType: TRealICQContacterListItemIconButtonType);
- var
- UploadMission: TUploadMission;
- DownloadMission: TDownloadMission;
- AMissionID: string;
- begin
- if Sender = FLVNetWorkDiskUploadingFiles then
- begin
- try
- if not Assigned(Item) then
- Exit;
- UploadMission := TUploadMission(Item.Data);
- if not Assigned(UploadMission) then
- Exit;
- AMissionID := UploadMission.FID;
- try
- FLVNetWorkDiskUploadingFiles.Items.Delete(Item.ItemIndex);
- FreeAndNil(UploadMission);
- except
- end;
- RealICQNetWorkDiskClient.CancelUploadingFile(AMissionID);
- finally
- CheckUploadMissions
- end;
- end;
- if Sender = FLVNetWorkDiskDownloadingFiles then
- begin
- try
- if not Assigned(Item) then
- Exit;
- FLVNetWorkDiskDownloadingFiles.Items.Delete(Item.ItemIndex);
- DownloadMission := TDownloadMission(Item.Data);
- FreeAndNil(DownloadMission);
- RealICQNetWorkDiskClient.StopDownloader;
- finally
- CheckDownloadMissions
- end;
- end;
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.NDMissionDropFiles(Sender: TObject; var Message: TMessage);
- var
- i: Integer;
- p: array[0..1023] of Char;
- AName: string;
- begin
- try
- if (FLVNetWorkDiskUploadingFiles.Items.Count > 0) or (FLVNetWorkDiskDownloadingFiles.Items.Count > 0) or (FSavedUploadMissions.Count > 0) then
- begin
- MessageBox(Handle, '抱歉，系统正忙!', '提示', MB_ICONINFORMATION);
- Exit;
- end;
- i := DragQueryFile(Message.wParam, $FFFFFFFF, nil, 0);
- for i := 0 to i - 1 do
- begin
- DragQueryFile(Message.wParam, i, p, 1024);
- AName := StrPas(p);
- if FileExists(AName) then
- begin
- AddUploadMission(mtFile, RealICQNetWorkDiskClient.CurrentDirectory.ID, AName, False);
- end
- else if DirectoryExists(AName) then
- begin
- AddUploadMission(mtDir, RealICQNetWorkDiskClient.CurrentDirectory.ID, AName, False);
- end;
- end;
- finally
- CheckUploadMissions;
- DragFinish(Message.wParam);
- Message.Result := 1;
- end;
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.miNDCancelClick(Sender: TObject);
- var
- ListItem: TRealICQContacterListItem;
- UploadMission: TUploadMission;
- DownloadMission: TDownloadMission;
- iLoop: Integer;
- begin
- if TabSetNDMissions.TabIndex = 0 then
- begin
- for iLoop := FLVNetWorkDiskUploadingFiles.Items.Count - 1 downto 0 do
- begin
- ListItem := FLVNetWorkDiskUploadingFiles.Items.Objects[iLoop] as TRealICQContacterListItem;
- if ListItem.Selected then
- begin
- UploadMission := TUploadMission(ListItem.Data);
- if ListItem.LoginState = stOnline then
- begin
- if UploadMission.FUploadMissionType = mtFile then
- begin
- RealICQNetWorkDiskClient.CancelUploadingFile(UploadMission.FID);
- Continue;
- end;
- end;
- FLVNetWorkDiskUploadingFiles.Items.Delete(iLoop);
- FreeAndNil(UploadMission);
- end;
- end;
- CheckUploadMissions;
- end;
- if TabSetNDMissions.TabIndex = 1 then
- begin
- for iLoop := FLVNetWorkDiskDownloadingFiles.Items.Count - 1 downto 0 do
- begin
- ListItem := FLVNetWorkDiskDownloadingFiles.Items.Objects[iLoop] as TRealICQContacterListItem;
- if ListItem.Selected then
- begin
- DownloadMission := TDownloadMission(ListItem.Data);
- FLVNetWorkDiskUploadingFiles.Items.Delete(iLoop);
- FreeAndNil(DownloadMission);
- if ListItem.LoginState = stOnline then
- begin
- RealICQNetWorkDiskClient.StopDownloader;
- end;
- end;
- end;
- CheckDownloadMissions;
- end;
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.spbNDMoveUpClick(Sender: TObject);
- begin
- if RealICQNetWorkDiskClient.CurrentDirectory.Parent <> nil then
- begin
- lblNDState.Caption := '正在载入...';
- RealICQNetWorkDiskClient.GetDirectory(RealICQNetWorkDiskClient.CurrentDirectory.Parent);
- end;
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.miNDRenameClick(Sender: TObject);
- var
- DirectoryName, FileName: string;
- AFile: TRealICQNetWorkDiskFile;
- ADirectory: TRealICQNetWorkDiskDirectory;
- ListItem, ListItem1: TRealICQContacterListItem;
- iLoop, jLoop: Integer;
- begin
- for iLoop := FLVNetWorkDisk.Items.Count - 1 downto 0 do
- begin
- ListItem := FLVNetWorkDisk.Items.Objects[iLoop] as TRealICQContacterListItem;
- if ListItem.Selected then
- begin
- if Copy(ListItem.LoginName, 1, 1) = 'D' then
- begin
- ADirectory := TRealICQNetWorkDiskDirectory(ListItem.Data);
- DirectoryName := Trim(ShowMyInputBox('重命名目录', '请输入新的目录名称', ADirectory.Name, 200));
- if AnsiSameStr(DirectoryName, ADirectory.Name) then
- Exit;
- if Length(DirectoryName) > 0 then
- begin
- if (Pos('\', DirectoryName) > 0) or (Pos('/', DirectoryName) > 0) or (Pos(':', DirectoryName) > 0) or (Pos('*', DirectoryName) > 0) or (Pos('"', DirectoryName) > 0) or (Pos('<', DirectoryName) > 0) or (Pos('>', DirectoryName) > 0) or (Pos('|', DirectoryName) > 0) then
- begin
- MessageBox(Handle, '目录名中不能出现下列任何字符之一'#$D#$A'\ / : * " < > |', '错误', MB_OK or MB_ICONINFORMATION);
- Exit;
- end;
- for jLoop := 0 to FLVNetWorkDisk.Items.Count - 1 do
- begin
- ListItem1 := FLVNetWorkDisk.Items.Objects[jLoop] as TRealICQContacterListItem;
- if ListItem1 = ListItem then
- continue;
- if Copy(ListItem1.LoginName, 1, 1) = 'D' then
- begin
- if AnsiSameText(DirectoryName, ListItem1.DisplayName) then
- begin
- MessageBox(Handle, '指定的目录已存在！', '提示', MB_OK or MB_ICONINFORMATION);
- Exit;
- end;
- end;
- end;
- RealICQNetWorkDiskClient.Rename(rtDir, ADirectory.ID, DirectoryName);
- end;
- end
- else if Copy(ListItem.LoginName, 1, 1) = 'F' then
- begin
- AFile := TRealICQNetWorkDiskFile(ListItem.Data);
- FileName := Trim(ShowMyInputBox('重命名文件', '请输入新的文件名称', AFile.Name, 200));
- if AnsiSameStr(FileName, AFile.Name) then
- Exit;
- if Length(FileName) > 0 then
- begin
- if (Pos('\', FileName) > 0) or (Pos('/', FileName) > 0) or (Pos(':', FileName) > 0) or (Pos('*', FileName) > 0) or (Pos('"', FileName) > 0) or (Pos('<', FileName) > 0) or (Pos('>', FileName) > 0) or (Pos('|', FileName) > 0) then
- begin
- MessageBox(Handle, '文件名中不能出现下列任何字符之一'#$D#$A'\ / : * " < > |', '错误', MB_OK or MB_ICONINFORMATION);
- Exit;
- end;
- for jLoop := 0 to FLVNetWorkDisk.Items.Count - 1 do
- begin
- ListItem1 := FLVNetWorkDisk.Items.Objects[jLoop] as TRealICQContacterListItem;
- if ListItem1 = ListItem then
- continue;
- if Copy(ListItem1.LoginName, 1, 1) = 'F' then
- begin
- if AnsiSameText(FileName, ListItem1.DisplayName) then
- begin
- MessageBox(Handle, '指定的文件已存在！', '提示', MB_OK or MB_ICONINFORMATION);
- Exit;
- end;
- end;
- end;
- RealICQNetWorkDiskClient.Rename(rtFile, AFile.ID, FileName);
- end;
- end;
- Exit;
- end;
- end;
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.spbNDNewDirClick(Sender: TObject);
- var
- DirectoryName: string;
- iLoop: Integer;
- ListItem: TRealICQContacterListItem;
- begin
- DirectoryName := Trim(ShowMyInputBox('新建目录', '请输入目录名称', '', 200));
- if Length(DirectoryName) > 0 then
- begin
- if (Pos('\', DirectoryName) > 0) or (Pos('/', DirectoryName) > 0) or (Pos(':', DirectoryName) > 0) or (Pos('*', DirectoryName) > 0) or (Pos('"', DirectoryName) > 0) or (Pos('<', DirectoryName) > 0) or (Pos('>', DirectoryName) > 0) or (Pos('|', DirectoryName) > 0) then
- begin
- MessageBox(Handle, '目录名中不能出现下列任何字符之一'#$D#$A'\ / : * " < > |', '错误', MB_OK or MB_ICONINFORMATION);
- Exit;
- end;
- for iLoop := FLVNetWorkDisk.Items.Count - 1 downto 0 do
- begin
- ListItem := FLVNetWorkDisk.Items.Objects[iLoop] as TRealICQContacterListItem;
- if Copy(ListItem.LoginName, 1, 1) = 'D' then
- begin
- if AnsiSameText(DirectoryName, ListItem.DisplayName) then
- begin
- MessageBox(Handle, '指定的目录已存在！', '提示', MB_OK or MB_ICONINFORMATION);
- Exit;
- end;
- end;
- end;
- RealICQNetWorkDiskClient.NewDirectory(DirectoryName);
- end;
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.spbNDRefreshClick(Sender: TObject);
- begin
- RealICQNetWorkDiskClient.Refresh;
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.GoNextLevelUploadMissions(UploadMission: TUploadMission);
- var
- iLoop: Integer;
- Missions: TStringList;
- ListItem: TRealICQContacterListItem;
- AUploadMission: TUploadMission;
- DSearchRec: TSearchRec;
- FindResult: Integer;
- begin
- if UploadMission.FUploadMissionType <> mtDir then
- Exit;
- Missions := TStringList.Create;
- for iLoop := 0 to FLVNetWorkDiskUploadingFiles.Items.Count - 1 do
- begin
- ListItem := FLVNetWorkDiskUploadingFiles.Items.Objects[iLoop] as TRealICQContacterListItem;
- AUploadMission := TUploadMission(ListItem.Data);
- Missions.AddObject(AUploadMission.FID, AUploadMission);
- try
- FUploadMissions.Delete(FUploadMissions.IndexOf(AUploadMission.ID));
- except
- end;
- end;
- FSavedUploadMissions.Add(Missions);
- FLVNetWorkDiskUploadingFiles.Items.Clear;
- FindResult := FindFirst(UploadMission.FName + '\*.*', faDirectory, DSearchRec);
- while FindResult = 0 do
- begin
- if (DSearchRec.Name <> '.') and (DSearchRec.Name <> '..') then
- begin
- if DirectoryExists(UploadMission.FName + '\' + DSearchRec.Name) then
- begin
- AddUploadMission(mtDir, RealICQNetWorkDiskClient.CurrentDirectory.ID, UploadMission.FName + '\' + DSearchRec.Name, False);
- end;
- end;
- FindResult := FindNext(DSearchRec);
- end;
- FindResult := FindFirst(UploadMission.FName + '\*.*', faAnyFile - faDirectory, DSearchRec);
- while FindResult = 0 do
- begin
- if (DSearchRec.Name <> '.') and (DSearchRec.Name <> '..') then
- begin
- if FileExists(UploadMission.FName + '\' + DSearchRec.Name) then
- begin
- AddUploadMission(mtFile, RealICQNetWorkDiskClient.CurrentDirectory.ID, UploadMission.FName + '\' + DSearchRec.Name, False);
- end;
- end;
- FindResult := FindNext(DSearchRec);
- end;
- CheckUploadMissions;
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.CheckUploadMissions;
- var
- ListItem: TRealICQContacterListItem;
- UploadMission: TUploadMission;
- Missions: TStringList;
- iLoop: Integer;
- ADirectory: TRealICQNetWorkDiskDirectory;
- AFile: TRealICQNetWorkDiskFile;
- Finded: Boolean;
- MessageBoxResult: Integer;
- ConfirmReplaceNDFileForm: TConfirmReplaceNDFileForm;
- begin
- if FLVNetWorkDiskUploadingFiles.OnlineNumeric = 0 then
- begin
- if FLVNetWorkDiskUploadingFiles.Items.Count > 0 then
- begin
- ListItem := FLVNetWorkDiskUploadingFiles.Items.Objects[0] as TRealICQContacterListItem;
- UploadMission := TUploadMission(ListItem.Data);
- if UploadMission.UploadMissionType = mtFile then
- begin
- with ListItem do
- begin
- LoginState := stOnline;
- HasSMS := True;
- Watchword := '';
- SMSHint := '取消';
- HeadImagePicture.LoadFromFile(ExtractFilePath(Application.ExeName) + UpBMP);
- ReDrawItem;
- end;
- for iLoop := RealICQNetWorkDiskClient.CurrentDirectory.Files.Count - 1 downto 0 do
- begin
- AFile := RealICQNetWorkDiskClient.CurrentDirectory.Files[iLoop];
- if AnsiSameText(ExtractFileName(AFile.Name), ExtractFileName(UploadMission.Name)) then
- begin
- if FConfirmReplaceResult <> mrYesToAll then
- begin
- ConfirmReplaceNDFileForm := TConfirmReplaceNDFileForm.Create(Self);
- ConfirmReplaceNDFileForm.Label1.Caption := Format(ConfirmReplaceNDFileForm.Label1.Caption, [ExtractFileName(AFile.Name)]);
- try
- FConfirmReplaceResult := ConfirmReplaceNDFileForm.ShowModal;
- finally
- FreeAndNil(ConfirmReplaceNDFileForm);
- end;
- end;
- if (FConfirmReplaceResult = mrYES) or (FConfirmReplaceResult = mrYesToAll) then
- begin
- //FreeAndNil(AFile);
- RealICQNetWorkDiskClient.Delete('F' + IntToStr(AFile.ID));
- Sleep(100);
- Application.ProcessMessages;
- Break;
- end
- else if FConfirmReplaceResult = mrNO then
- begin
- FLVNetWorkDiskUploadingFiles.Items.Delete(0);
- FreeAndNil(UploadMission);
- CheckUploadMissions;
- Exit;
- end
- else if FConfirmReplaceResult = mrCancel then
- begin
- spbNDCancelAllClick(spbNDCancelAll);
- Exit;
- end;
- end;
- end;
- while True do
- begin
- try
- RealICQNetWorkDiskClient.UploadFile(UploadMission.Name, UploadMission.DirectoryID, UploadMission.ID);
- Break;
- except
- on E: Exception do
- begin
- MessageBoxResult := MessageBox(Handle, PChar('上传文件时出错：'#$D#$A#$D#$A + E.Message), '提示', MB_ICONERROR or MB_ABORTRETRYIGNORE);
- if MessageBoxResult = ID_ABORT then
- begin
- spbNDCancelAllClick(spbNDCancelAll);
- Exit;
- end
- else if MessageBoxResult = ID_RETRY then
- begin
- Continue;
- end
- else if MessageBoxResult = ID_IGNORE then
- begin
- FLVNetWorkDiskUploadingFiles.Items.Delete(ListItem.ItemIndex);
- FreeAndNil(UploadMission);
- CheckUploadMissions;
- Exit;
- end;
- end;
- end; //try
- end; //while
- end
- else
- begin
- with ListItem do
- begin
- LoginState := stOnline;
- HeadImagePicture.LoadFromFile(ExtractFilePath(Application.ExeName) + UpBMP);
- ReDrawItem;
- end;
- Finded := False;
- for iLoop := 0 to RealICQNetWorkDiskClient.CurrentDirectory.Directories.Count - 1 do
- begin
- ADirectory := RealICQNetWorkDiskClient.CurrentDirectory.Directories[iLoop];
- if Length(ExtractFileName(UploadMission.Name)) > 0 then
- begin
- if AnsiSameText(ADirectory.Name, ExtractFileName(UploadMission.Name)) then
- begin
- RealICQNetWorkDiskClient.GetDirectory(ADirectory);
- Finded := True;
- end;
- end
- else
- begin
- if AnsiSameText(ADirectory.Name, '[' + Copy(UploadMission.Name, 1, 1) + ']') then
- begin
- RealICQNetWorkDiskClient.GetDirectory(ADirectory);
- Finded := True;
- end;
- end;
- end;
- if not Finded then
- begin
- if Length(ExtractFileName(UploadMission.Name)) = 0 then
- RealICQNetWorkDiskClient.NewDirectory('[' + Copy(UploadMission.Name, 1, 1) + ']')
- else
- RealICQNetWorkDiskClient.NewDirectory(ExtractFileName(UploadMission.Name));
- end;
- end;
- end;
- end;
- TabSetNDMissions.Tabs.Strings[0] := Format('上传(%d)', [FLVNetWorkDiskUploadingFiles.Items.Count]);
- if FLVNetWorkDiskUploadingFiles.Items.Count = 0 then
- begin
- if FSavedUploadMissions.Count > 0 then
- begin
- if (RealICQNetWorkDiskClient.CurrentDirectory.Parent <> nil) then
- begin
- if (RealICQNetWorkDiskClient.CurrentDirectory.Parent.FromServerVersion) then
- begin
- RealICQNetWorkDiskClient.GetDirectory(RealICQNetWorkDiskClient.CurrentDirectory.Parent);
- Missions := TStringList(FSavedUploadMissions[FSavedUploadMissions.Count - 1]);
- FSavedUploadMissions.Remove(Missions);
- for iLoop := 0 to Missions.Count - 1 do
- begin
- UploadMission := Missions.Objects[iLoop] as TUploadMission;
- AddUploadMission(UploadMission.UploadMissionType, UploadMission.DirectoryID, UploadMission.Name, False);
- FreeAndNil(UploadMission);
- end;
- Missions.Clear;
- FreeAndNil(Missions);
- CheckUploadMissions;
- Exit;
- end;
- end;
- end
- else
- begin
- RealICQNetWorkDiskClient.GetUsedSpaceSize;
- end;
- end;
- CheckNDControlState;
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.CheckNDControlState;
- begin
- if (FLVNetWorkDiskUploadingFiles <> nil) and (FLVNetWorkDiskUploadingFiles.Items.Count = 0) and (FLVNetWorkDiskDownloadingFiles.Items.Count = 0) and (FSavedUploadMissions.Count = 0) and (FSavedDownloadMissions.Count = 0) then
- begin
- pnlNDMissions.Visible := False;
- SplitterNDMissions.Visible := pnlNDMissions.Visible;
- end;
- spbNDMoveUp.Enabled := not pnlNDMissions.Visible;
- spbNDNewDir.Enabled := not pnlNDMissions.Visible;
- spbNDDelete.Enabled := not pnlNDMissions.Visible;
- spbNDUpload.Enabled := not pnlNDMissions.Visible;
- spbNDDownload.Enabled := not pnlNDMissions.Visible;
- spbNDRefresh.Enabled := not pnlNDMissions.Visible;
- spbNDCancelAll.Enabled := pnlNDMissions.Visible;
- spbNDMoveUp.Enabled := (not pnlNDMissions.Visible) and (RealICQNetWorkDiskClient <> nil) and (RealICQNetWorkDiskClient.CurrentDirectory <> nil) and (RealICQNetWorkDiskClient.CurrentDirectory.Parent <> nil) and (RealICQNetWorkDiskClient.Connected);
- if not pnlNDMissions.Visible then
- begin
- FConfirmReplaceResult := -1;
- FLastDownloadDirectory := '';
- NDSelectItemChanged(nil);
- end;
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.AddUploadMission(AUploadMissionType: TNDMissionType; ADirectoryID: Integer; AName: string; CheckMission: Boolean = True);
- var
- UploadMission: TUploadMission;
- ItemIndex: Integer;
- ListItem: TRealICQContacterListItem;
- begin
- UploadMission := TUploadMission.Create(AUploadMissionType, ADirectoryID, AName);
- if FUploadMissions.IndexOf(UploadMission.ID) >= 0 then
- begin
- MessageBox(Handle, PChar(AName + ' 已在任务队列中！'), '提示', MB_ICONINFORMATION);
- Exit;
- end;
- FUploadMissions.AddObject(UploadMission.ID, UploadMission);
- if not pnlNDMissions.Visible then
- pnlNDMissions.Visible := True;
- TabSetNDMissions.TabIndex := 0;
- SplitterNDMissions.Visible := pnlNDMissions.Visible;
- SplitterNDMissions.Top := pnlNDMissions.Top - 10;
- ItemIndex := FLVNetWorkDiskUploadingFiles.Items.IndexOf(UploadMission.ID);
- if ItemIndex >= 0 then
- FLVNetWorkDiskUploadingFiles.Items.Delete(ItemIndex);
- ItemIndex := FLVNetWorkDiskUploadingFiles.Items.Add(UploadMission.ID);
- ListItem := FLVNetWorkDiskUploadingFiles.Items.Objects[ItemIndex] as TRealICQContacterListItem;
- with ListItem do
- begin
- LoginState := stOffline;
- Data := UploadMission;
- DisplayName := (UploadMission.Name);
- Watchword := '队列中';
- if UploadMission.UploadMissionType = mtFile then
- begin
- try
- HeadImagePicture.LoadFromFile(GetBitmapFromFileExt(UploadMission.Name));
- except
- end;
- end;
- ReDrawItem;
- end;
- TabSetNDMissions.Tabs.Strings[0] := Format('上传(%d)', [FLVNetWorkDiskUploadingFiles.Items.Count]);
- if CheckMission then
- CheckUploadMissions;
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.AddDownloadMission(ADownloadMissionType: TNDMissionType; ADirectoryName: string; AFileID: Integer = 0; AFileName: string = ''; CheckMission: Boolean = True);
- var
- DownloadMission: TDownloadMission;
- ItemIndex: Integer;
- ListItem: TRealICQContacterListItem;
- begin
- DownloadMission := TDownloadMission.Create(ADownloadMissionType, ADirectoryName, AFileID, AFileName);
- if not pnlNDMissions.Visible then
- pnlNDMissions.Visible := True;
- TabSetNDMissions.TabIndex := 1;
- SplitterNDMissions.Visible := pnlNDMissions.Visible;
- SplitterNDMissions.Top := pnlNDMissions.Top - 10;
- ItemIndex := FLVNetWorkDiskDownloadingFiles.Items.Add(DownloadMission.ID);
- ListItem := FLVNetWorkDiskDownloadingFiles.Items.Objects[ItemIndex] as TRealICQContacterListItem;
- with ListItem do
- begin
- LoginState := stOffline;
- Data := DownloadMission;
- Watchword := '队列中';
- if DownloadMission.DownloadMissionType = mtFile then
- begin
- DisplayName := (DownloadMission.FileName);
- try
- HeadImagePicture.LoadFromFile(GetBitmapFromFileExt(DownloadMission.FileName));
- except
- end;
- end
- else
- begin
- DisplayName := (DownloadMission.DirectoryName);
- end;
- ReDrawItem;
- end;
- TabSetNDMissions.Tabs.Strings[1] := Format('下载(%d)', [FLVNetWorkDiskDownloadingFiles.Items.Count]);
- if CheckMission then
- CheckDownloadMissions;
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.CheckDownloadMissions;
- var
- iLoop, jLoop: Integer;
- ListItem: TRealICQContacterListItem;
- DownloadMission: TDownloadMission;
- ADownloadMission: TDownloadMission;
- ADirectory: TRealICQNetWorkDiskDirectory;
- Missions: TStringList;
- begin
- if FLVNetWorkDiskDownloadingFiles.OnlineNumeric = 0 then
- begin
- if FLVNetWorkDiskDownloadingFiles.Items.Count > 0 then
- begin
- ListItem := FLVNetWorkDiskDownloadingFiles.Items.Objects[0] as TRealICQContacterListItem;
- DownloadMission := TDownloadMission(ListItem.Data);
- if DownloadMission.DownloadMissionType = mtFile then
- begin
- with ListItem do
- begin
- LoginState := stOnline;
- HasSMS := True;
- Watchword := '';
- SMSHint := '取消';
- HeadImagePicture.LoadFromFile(ExtractFilePath(Application.ExeName) + DownBMP);
- ReDrawItem;
- end;
- if FileExists(DownloadMission.FFileName) then
- begin
- if FConfirmReplaceResult <> mrYesToAll then
- begin
- ConfirmReplaceNDFileForm := TConfirmReplaceNDFileForm.Create(Self);
- ConfirmReplaceNDFileForm.Label1.Caption := Format(ConfirmReplaceNDFileForm.Label1.Caption, [ExtractFileName(DownloadMission.FFileName)]);
- try
- FConfirmReplaceResult := ConfirmReplaceNDFileForm.ShowModal;
- finally
- FreeAndNil(ConfirmReplaceNDFileForm);
- end;
- end;
- if (FConfirmReplaceResult = mrYES) or (FConfirmReplaceResult = mrYesToAll) then
- begin
- end
- else if FConfirmReplaceResult = mrNO then
- begin
- FLVNetWorkDiskDownloadingFiles.Items.Delete(0);
- FreeAndNil(DownloadMission);
- CheckDownloadMissions;
- Exit;
- end
- else if FConfirmReplaceResult = mrCancel then
- begin
- spbNDCancelAllClick(spbNDCancelAll);
- Exit;
- end;
- end;
- try
- RealICQNetWorkDiskClient.DownloadFile(DownloadMission.FFileID, DownloadMission.FFileName);
- except
- FLVNetWorkDiskDownloadingFiles.Items.Delete(0);
- FreeAndNil(DownloadMission);
- CheckDownloadMissions;
- Exit;
- end;
- end
- else
- begin
- with ListItem do
- begin
- LoginState := stOnline;
- HeadImagePicture.LoadFromFile(ExtractFilePath(Application.ExeName) + DownBMP);
- ReDrawItem;
- end;
- for iLoop := 0 to RealICQNetWorkDiskClient.CurrentDirectory.Directories.Count - 1 do
- begin
- ADirectory := TRealICQNetWorkDiskDirectory(RealICQNetWorkDiskClient.CurrentDirectory.Directories[iLoop]);
- if AnsiSameText(ExtractFileName(ADirectory.Name), ExtractFileName(DownloadMission.DirectoryName)) then
- begin
- if not DirectoryExists(DownloadMission.DirectoryName) then
- CreateDir(DownloadMission.DirectoryName);
- FLastDownloadDirectory := DownloadMission.DirectoryName;
- FLVNetWorkDiskDownloadingFiles.Items.Delete(0);
- FreeAndNil(DownloadMission);
- Missions := TStringList.Create;
- for jLoop := 0 to FLVNetWorkDiskDownloadingFiles.Items.Count - 1 do
- begin
- ListItem := FLVNetWorkDiskDownloadingFiles.Items.Objects[jLoop] as TRealICQContacterListItem;
- ADownloadMission := TDownloadMission(ListItem.Data);
- Missions.AddObject(ADownloadMission.FID, ADownloadMission);
- end;
- FSavedDownloadMissions.Add(Missions);
- FLVNetWorkDiskDownloadingFiles.Items.Clear;
- RealICQNetWorkDiskClient.GetDirectory(ADirectory);
- Exit;
- end;
- end;
- end;
- end;
- end;
- TabSetNDMissions.Tabs.Strings[1] := Format('下载(%d)', [FLVNetWorkDiskDownloadingFiles.Items.Count]);
- if FLVNetWorkDiskDownloadingFiles.Items.Count = 0 then
- begin
- if FSavedDownloadMissions.Count > 0 then
- begin
- if (RealICQNetWorkDiskClient.CurrentDirectory.Parent <> nil) then
- begin
- if (RealICQNetWorkDiskClient.CurrentDirectory.Parent.FromServerVersion) then
- begin
- FLastDownloadDirectory := '';
- RealICQNetWorkDiskClient.GetDirectory(RealICQNetWorkDiskClient.CurrentDirectory.Parent);
- Missions := TStringList(FSavedDownloadMissions[FSavedDownloadMissions.Count - 1]);
- FSavedDownloadMissions.Remove(Missions);
- for iLoop := 0 to Missions.Count - 1 do
- begin
- DownloadMission := Missions.Objects[iLoop] as TDownloadMission;
- AddDownloadMission(DownloadMission.DownloadMissionType, DownloadMission.DirectoryName, DownloadMission.FileID, DownloadMission.FileName, False);
- FreeAndNil(DownloadMission);
- end;
- Missions.Clear;
- FreeAndNil(Missions);
- CheckDownloadMissions;
- Exit;
- end;
- end;
- end;
- end;
- CheckNDControlState;
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.spbNDUploadClick(Sender: TObject);
- var
- iLoop: Integer;
- begin
- MainForm.FormStyle := fsNormal;
- try
- if UploadFileOpenDialog.Execute then
- begin
- for iLoop := 0 to UploadFileOpenDialog.Files.Count - 1 do
- begin
- AddUploadMission(mtFile, RealICQNetWorkDiskClient.CurrentDirectory.ID, UploadFileOpenDialog.Files.Strings[iLoop], False);
- end;
- end;
- finally
- // if MainForm.AlwaysOnTop then
- // MainForm.FormStyle := fsStayOnTop
- // else
- // MainForm.FormStyle := fsNormal;
-
CheckUploadMissions;
- end;
- end;
- procedure TMainForm.spbNextClick(Sender: TObject);
- var
- TabSheet: TTabSheet;
- WebBrowser: TWebBrowser;
- begin
- try
- TabSheet := pgcMultiWeb.ActivePage;
- WebBrowser := (TabSheet.Controls[0] as TPanel).Controls[0] as TWebBrowser;
- if WebBrowser.Busy then
- WebBrowser.Stop;
- WebBrowser.GoForward;
- except
- end;
- end;
- //function TMainForm.GetDefaultBrowser: string;//获取默认浏览器
-
//var
- // reg: TRegistry;
- //begin
- // reg := TRegistry.Create;
- // try
- // {reg.RootKey := HKEY_CLASSES_ROOT;
- // reg.OpenKey('HTTP\shell\open\ddeexec\Application',false);
- // result:=reg.ReadString('');
- // reg.CloseKey; }
-
// reg.RootKey := HKEY_CLASSES_ROOT;
- // reg.OpenKey('http\\shell\\open\\command', false);
- // result := reg.ReadString('');
- // result := Copy(result, Pos('"', result) + 1, Length(result) - 1);
- // result := Copy(result, 1, Pos('"', result) - 1);
- // reg.CloseKey;
- // finally
- // if (result = '') then
- // result := 'IEXPLORE.EXE';
- // reg.Free;
- // end;
- //end;
- //---用户自助管理平台--------------------------------------
- procedure TMainForm.spbPersonManageClick(Sender: TObject);
- //var
- // EncryptStr,
- // Md5Pwd,
- // Url,
- // TmpStr:String;
-
begin
- //Md5Pwd:=Md5En(RealICQClient.Password);
- //TmpStr:='{'+RealICQClient.Me.LoginName+'}{'+Md5Pwd+'}';
- //EncryptStr:=StrToBase64(Encrypt(TmpStr,'B77A5C561934E089'));
- //Url:=RealICQClient.PersonManageUrl+'?'+ EncryptStr;
- //ShellExecute(handle,'open', 'IEXPLORE.EXE', 'http://www.baidu.com', nil,SW_SHOWNORMAL);//
- // ShellExecute(handle, 'open','http://220.191.210.103:8080/Default.aspx?url=', '','',SW_SHOWDEFAULT);
- //MessageBox(Handle, PChar(RealICQClient.WebAppBaseURL), '提示', MB_ICONQUESTION);
- //MessageBox(Handle, PChar(LoginURL), '提示', MB_ICONQUESTION);
- //ShellExecute(handle, 'open', PChar(GetDefaultBrowser),PChar(Format(RealICQClient.WebAppBaseURL + LoginURL, [StrToBase64(RealICQClient.LoginName), StrToBase64(MD5En(RealICQClient.Password)), ''])), '',SW_SHOWDEFAULT);
-
if FNewConsole then
- ShellExecute(handle, 'open', PChar(GetDefaultBrowser), PChar(Format(RealICQClient.WebAppBaseURL + NewBaseURL, [StrToBase64(RealICQClient.LoginName), StrToBase64(MD5En(RealICQClient.Password)), StrToBase64(LoginURL)])), '', SW_SHOWDEFAULT)
- else
- ShellExecute(handle, 'open', PChar(GetDefaultBrowser), PChar(Format(RealICQClient.WebAppBaseURL + BaseURL, [StrToBase64(RealICQClient.LoginName), StrToBase64(MD5En(RealICQClient.Password)), StrToBase64(LoginURL)])), '', SW_SHOWDEFAULT);
- end;
- procedure TMainForm.spbPrevClick(Sender: TObject);
- var
- TabSheet: TTabSheet;
- WebBrowser: TWebBrowser;
- begin
- try
- TabSheet := pgcMultiWeb.ActivePage;
- WebBrowser := (TabSheet.Controls[0] as TPanel).Controls[0] as TWebBrowser;
- if WebBrowser.Busy then
- WebBrowser.Stop;
- WebBrowser.GoBack;
- except
- end;
- end;
- procedure TMainForm.spbPrintPrevClick(Sender: TObject);
- var
- TabSheet: TTabSheet;
- WebBrowser: TWebBrowser;
- begin
- MainForm.FormStyle := fsNormal;
- try
- try
- TabSheet := pgcMultiWeb.ActivePage;
- WebBrowser := (TabSheet.Controls[0] as TPanel).Controls[0] as TWebBrowser;
- if WebBrowser.QueryStatusWB(OLECMDID_PRINTPREVIEW) = 3 then
- WebBrowser.ExecWB(OLECMDID_PRINTPREVIEW, OLECMDEXECOPT_DODEFAULT, EmptyParam, EmptyParam);
- except
- end;
- finally
- // if MainForm.AlwaysOnTop then
- // MainForm.FormStyle := fsStayOnTop
- // else
- // MainForm.FormStyle := fsNormal;
- end;
- end;
- procedure TMainForm.spbRefreshBranchUsersClick(Sender: TObject);
- begin
- //
- {TimerForGetBranchOnlineStates.Enabled := False;
- TimerForGetBranchOnlineStates.Enabled := True;}
- miChangeServerClick(nil);
- TimerForGetBranchUsersOnlineStates.Enabled := False;
- TimerForGetBranchUsersOnlineStates.Enabled := True;
- end;
- procedure TMainForm.spbRefreshClick(Sender: TObject);
- var
- TabSheet: TTabSheet;
- WebBrowser: TWebBrowser;
- begin
- try
- TabSheet := pgcMultiWeb.ActivePage;
- WebBrowser := (TabSheet.Controls[0] as TPanel).Controls[0] as TWebBrowser;
- if WebBrowser.Busy then
- WebBrowser.Stop;
- WebBrowser.Refresh;
- except
- end;
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.RealICQNetWorkDiskClientNewDirResult(Sender: TObject; Directory: TRealICQNetWorkDiskDirectory);
- var
- ItemIndex: Integer;
- ListItem: TRealICQContacterListItem;
- UploadMission: TUploadMission;
- NDDirName: string;
- begin
- if FLVNetWorkDiskUploadingFiles.Items.Count > 0 then
- begin
- ListItem := FLVNetWorkDiskUploadingFiles.Items.Objects[0] as TRealICQContacterListItem;
- UploadMission := TUploadMission(ListItem.Data);
- if UploadMission.UploadMissionType = mtDir then
- begin
- if Length(ExtractFileName(UploadMission.Name)) = 0 then
- NDDirName := '[' + Copy(UploadMission.Name, 1, 1) + ']'
- else
- NDDirName := ExtractFileName(UploadMission.Name);
- if AnsiSameText(NDDirName, Directory.Name) and (Directory.ParentID = UploadMission.DirectoryID) then
- begin
- RealICQNetWorkDiskClient.GetDirectory(Directory);
- Exit;
- end;
- end;
- end;
- if Directory.Parent <> RealICQNetWorkDiskClient.CurrentDirectory then
- Exit;
- ItemIndex := FLVNetWorkDisk.Items.Add('D' + IntToStr(Directory.ID));
- ListItem := FLVNetWorkDisk.Items.Objects[ItemIndex] as TRealICQContacterListItem;
- with ListItem do
- begin
- LoginState := stOnline;
- Data := Directory;
- DisplayName := Directory.Name;
- ReDrawItem;
- end;
- lblNDState.Caption := Format('目录: %d 文件: %d', [RealICQNetWorkDiskClient.CurrentDirectory.Directories.Count, RealICQNetWorkDiskClient.CurrentDirectory.Files.Count]);
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.RealICQNetWorkDiskClientNoSpace(Sender: TObject);
- begin
- ShowNetWorkDiskSpaceInfo;
- spbNDCancelAllClick(spbNDCancelAll);
- MessageBox(Handle, '抱歉！您的网络硬盘空间不足，任务已取消！', '提示', MB_ICONINFORMATION);
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.RealICQNetWorkDiskClientRenamedDir(Sender: TObject; ADirectory: TRealICQNetWorkDiskDirectory);
- var
- ItemIndex: Integer;
- ListItem: TRealICQContacterListItem;
- begin
- FLVNetWorkDisk.AdjustPosition := False;
- try
- if ADirectory.Parent <> RealICQNetWorkDiskClient.CurrentDirectory then
- Exit;
- ItemIndex := FLVNetWorkDisk.Items.IndexOf('D' + IntToStr(ADirectory.ID));
- if ItemIndex < 0 then
- Exit;
- ListItem := FLVNetWorkDisk.Items.Objects[ItemIndex] as TRealICQContacterListItem;
- with ListItem do
- begin
- LoginState := stOnline;
- Data := ADirectory;
- DisplayName := ADirectory.Name;
- ReDrawItem;
- end;
- finally
- FLVNetWorkDisk.AdjustPosition := True;
- end;
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.RealICQNetWorkDiskClientRenamedFile(Sender: TObject; AFile: TRealICQNetWorkDiskFile);
- var
- ItemIndex: Integer;
- ListItem: TRealICQContacterListItem;
- begin
- FLVNetWorkDisk.AdjustPosition := False;
- try
- if AFile.Parent <> RealICQNetWorkDiskClient.CurrentDirectory then
- Exit;
- ItemIndex := FLVNetWorkDisk.Items.IndexOf('F' + IntToStr(AFile.ID));
- if ItemIndex < 0 then
- Exit;
- ListItem := FLVNetWorkDisk.Items.Objects[ItemIndex] as TRealICQContacterListItem;
- with ListItem do
- begin
- LoginState := stLeave;
- Data := AFile;
- DisplayName := AFile.Name;
- try
- HeadImagePicture.LoadFromFile(GetBitmapFromFileExt(AFile.Name));
- except
- end;
- ReDrawItem;
- end;
- finally
- FLVNetWorkDisk.AdjustPosition := True;
- end;
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.RealICQNetWorkDiskClientUploadedFile(Sender: TObject; AFile: TRealICQNetWorkDiskFile; AMissionID: string);
- var
- iLoop: Integer;
- ItemIndex: Integer;
- ListItem: TRealICQContacterListItem;
- UploadMission: TUploadMission;
- AFile1: TRealICQNetWorkDiskFile;
- Finded: Boolean;
- begin
- try
- ItemIndex := FLVNetWorkDiskUploadingFiles.Items.IndexOf(AMissionID);
- if ItemIndex >= 0 then
- begin
- ListItem := FLVNetWorkDiskUploadingFiles.Items.Objects[ItemIndex] as TRealICQContacterListItem;
- FLVNetWorkDiskUploadingFiles.Items.Delete(ItemIndex);
- UploadMission := TUploadMission(ListItem.Data);
- FreeAndNil(UploadMission);
- end;
- FLVNetWorkDisk.AdjustPosition := False;
- try
- if AFile.Parent <> RealICQNetWorkDiskClient.CurrentDirectory then
- Exit;
- Finded := False;
- ListItem := nil;
- for iLoop := FLVNetWorkDisk.Items.Count - 1 downto 0 do
- begin
- ListItem := FLVNetWorkDisk.Items.Objects[iLoop] as TRealICQContacterListItem;
- if Copy(ListItem.LoginName, 1, 1) = 'F' then
- begin
- AFile1 := TRealICQNetWorkDiskFile(ListItem.Data);
- if AnsiSameText(AFile1.Name, AFile.Name) then
- begin
- Finded := True;
- Break;
- end;
- end;
- end;
- if not Finded then
- begin
- ItemIndex := FLVNetWorkDisk.Items.IndexOf('F' + IntToStr(AFile.ID));
- if ItemIndex >= 0 then
- begin
- ListItem := FLVNetWorkDisk.Items.Objects[ItemIndex] as TRealICQContacterListItem;
- Finded := True;
- end;
- end;
- if not Finded then
- begin
- ItemIndex := FLVNetWorkDisk.Items.Add('F' + IntToStr(AFile.ID));
- ListItem := FLVNetWorkDisk.Items.Objects[ItemIndex] as TRealICQContacterListItem;
- end;
- with ListItem do
- begin
- LoginState := stLeave;
- Data := AFile;
- DisplayName := AFile.Name;
- if AFile.Size >= 1024 * 1024 then
- Watchword := Format('%0.1fMB', [AFile.Size / (1024 * 1024)])
- else if AFile.Size >= 1024 then
- Watchword := IntToStr(AFile.Size div 1024) + 'KB'
- else
- Watchword := IntToStr(AFile.Size) + 'B';
- try
- HeadImagePicture.LoadFromFile(GetBitmapFromFileExt(AFile.Name));
- except
- end;
- ReDrawItem;
- end;
- finally
- FLVNetWorkDisk.AdjustPosition := True;
- lblNDState.Caption := Format('目录: %d 文件: %d', [RealICQNetWorkDiskClient.CurrentDirectory.Directories.Count, RealICQNetWorkDiskClient.CurrentDirectory.Files.Count]);
- ShowNetWorkDiskSpaceInfo;
- end;
- finally
- CheckUploadMissions;
- end;
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.RealICQNetWorkDiskClientUploadFileAborted(Sender: TObject; AMissionID: string);
- var
- ItemIndex: Integer;
- ListItem: TRealICQContacterListItem;
- UploadMission: TUploadMission;
- begin
- try
- ItemIndex := FLVNetWorkDiskUploadingFiles.Items.IndexOf(AMissionID);
- if ItemIndex >= 0 then
- begin
- ListItem := FLVNetWorkDiskUploadingFiles.Items.Objects[ItemIndex] as TRealICQContacterListItem;
- FLVNetWorkDiskUploadingFiles.Items.Delete(ItemIndex);
- UploadMission := TUploadMission(ListItem.Data);
- FreeAndNil(UploadMission);
- end;
- finally
- CheckUploadMissions;
- end;
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.RealICQNetWorkDiskClientUploadingFile(Sender: TObject; ATransmitter: TResponsionStreamTransmitter; ATransmittedSize: Int64);
- var
- ItemIndex: Integer;
- ListItem: TRealICQContacterListItem;
- Completed: Integer;
- ASpeed: Cardinal;
- SpeedStr: string;
- begin
- ItemIndex := FLVNetWorkDiskUploadingFiles.Items.IndexOf((ATransmitter as TNetWorkFileTransmitter).MissionID);
- if ItemIndex >= 0 then
- begin
- ListItem := FLVNetWorkDiskUploadingFiles.Items.Objects[ItemIndex] as TRealICQContacterListItem;
- with ListItem do
- begin
- Completed := ATransmittedSize * 100 div ATransmitter.StreamLength;
- try
- ASpeed := Round(ATransmittedSize div ((GetTickCount - ATransmitter.StartTicket) div 1000) * 1.2);
- except
- Exit;
- end;
- if ASpeed > 1000 * 1000 then
- SpeedStr := Format('%0.1fMB/秒', [ASpeed / (1000 * 1000)])
- else if ASpeed > 1000 then
- SpeedStr := Format('%0.1fKB/秒', [ASpeed / 1000])
- else
- SpeedStr := Format('%d字节/秒', [ASpeed]);
- DisplayName := '(' + IntToStr(Completed) + '%，' + SpeedStr + ')';
- DisplayName := DisplayName + ((ATransmitter as TNetWorkFileTransmitter).FileName);
- ReDrawItem;
- end;
- end;
- end;
- function ServiceGetStatus(sMachine, sService: string): DWord;
- var
- //service control
- //manager handle
- schm,
- //service handle
- schs: SC_Handle;
- //service status
- ss: TServiceStatus;
- //current service status
- dwStat: DWord;
- begin
- dwStat := 0;
- //connect to the service
- //control manager
- schm := OpenSCManager(pchar(sMachine), Nil, SC_MANAGER_CONNECT);
- //if successful...
- if (schm > 0) then
- begin
- //open a handle to
- //the specified service
- schs := OpenService(schm, PChar(sService), SERVICE_QUERY_STATUS);
- //if successful...
- if (schs > 0) then
- begin
- //retrieve the current status
- //of the specified service
- if (QueryServiceStatus(schs, ss)) then
- begin
- dwStat := ss.dwCurrentState;
- end;
- //close service handle
- CloseServiceHandle(schs);
- end;
- // close service control
- // manager handle
- CloseServiceHandle(schm);
- end;
- Result := dwStat;
- end;
- function ServiceUninstalled(sMachine, sService: string): boolean;
- begin
- Result := 0 = ServiceGetStatus(sMachine, sService);
- end;
- //------------------------------------------------------------------------------
- //调用360杀毒软件
- //------------------------------------------------------------------------------
- //procedure TMainForm.spb360SDClick(Sender: TObject);
- //begin
- // //
-
//
-
//
-
//
- //end;
- //------------------------------------------------------------------------------
- //调用360安全卫士
- //------------------------------------------------------------------------------
-
//
- //procedure TMainForm.spb360SafeClick(Sender: TObject);
- //var
- // URL: string;
- // TempReg: TRegistry;
- // safePath: string;
- //begin
- //
- // URL := 'http://' + self.RealICQClient.RemoteAddress + '/client/setup.exe';
- //
- // try
- // TempReg := TRegistry.Create;
- // try
- // TempReg.RootKey := HKEY_LOCAL_MACHINE;
- // if not TempReg.OpenKey('\Software\360Safe\menuext\LiveUpdate360', False) then
- // //DownloadUpdate(URL)
-
//
-
//
- // else
- // begin
- // safePath := ExtractFilePath(TempReg.ReadString('Application'));
- // //WinExec(PChar(safePath+'\360Safe.exe'),SW_SHOW);
-
//
-
//
-
//
- // end;
- //
- // finally
- // TempReg.Free;
- // end;
- // except
- // end;
- //
- //end;
- //------------------------------------------------------------------------------
- procedure TMainForm.spbNDDeleteClick(Sender: TObject);
- var
- ListItem: TRealICQContacterListItem;
- iLoop: Integer;
- AList: string;
- begin
- if FLVNetWorkDisk.SelCount <= 0 then
- Exit;
- if (GetKeyState(VK_Shift) and - 128) = 0 then
- begin
- if MessageBox(Handle, '确认要删除选中的文件吗？', '提示', MB_ICONQUESTION or MB_OKCANCEL) <> ID_OK then
- Exit;
- end;
- AList := '';
- for iLoop := FLVNetWorkDisk.Items.Count - 1 downto 0 do
- begin
- ListItem := FLVNetWorkDisk.Items.Objects[iLoop] as TRealICQContacterListItem;
- if ListItem.Selected then
- begin
- AList := AList + ListItem.LoginName + Chr(10);
- end;
- if Length(AList) >= 1024 then
- begin
- RealICQNetWorkDiskClient.Delete(AList);
- AList := '';
- Sleep(1000);
- end;
- end;
- if Length(AList) > 0 then
- RealICQNetWorkDiskClient.Delete(AList);
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.spbNDDisconnectClick(Sender: TObject);
- begin
- RealICQNetWorkDiskClient.Logout;
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.spbNDDownloadClick(Sender: TObject);
- var
- iLoop: Integer;
- ListItem: TRealICQContacterListItem;
- Dir: string;
- AFile: TRealICQNetWorkDiskFile;
- ADirectory: TRealICQNetWorkDiskDirectory;
- begin
- if FLVNetWorkDisk.SelCount = 0 then
- Exit;
- if FLVNetWorkDisk.SelCount = 1 then
- begin
- for iLoop := 0 to FLVNetWorkDisk.Items.Count - 1 do
- begin
- ListItem := FLVNetWorkDisk.Items.Objects[iLoop] as TRealICQContacterListItem;
- if ListItem.Selected then
- begin
- if Copy(ListItem.LoginName, 1, 1) = 'F' then
- begin
- NDItemDoubleClick(ListItem);
- Exit;
- end;
- end;
- end;
- end;
- MainForm.FormStyle := fsNormal;
- try
- if SelectDirectory('请选择目录', '', Dir) then
- begin
- for iLoop := 0 to FLVNetWorkDisk.Items.Count - 1 do
- begin
- ListItem := FLVNetWorkDisk.Items.Objects[iLoop] as TRealICQContacterListItem;
- if ListItem.Selected then
- begin
- if Copy(ListItem.LoginName, 1, 1) = 'D' then
- begin
- ADirectory := TRealICQNetWorkDiskDirectory(ListItem.Data);
- AddDownloadMission(mtDir, Dir + '\' + ADirectory.Name, 0, '', False);
- end
- else
- begin
- AFile := TRealICQNetWorkDiskFile(ListItem.Data);
- AddDownloadMission(mtFile, ExtractFilePath(Dir), AFile.ID, Dir + '\' + AFile.Name, False);
- end;
- end;
- end; //for
- CheckDownloadMissions;
- end;
- finally
- // if MainForm.AlwaysOnTop then
- // MainForm.FormStyle := fsStayOnTop
- // else
- // MainForm.FormStyle := fsNormal;
-
end;
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.NDItemDoubleClick(Item: TRealICQContacterListItem);
- var
- AFile: TRealICQNetWorkDiskFile;
- ADirectory: TRealICQNetWorkDiskDirectory;
- begin
- if (FLVNetWorkDiskUploadingFiles.Items.Count > 0) or (FLVNetWorkDiskDownloadingFiles.Items.Count > 0) or (FSavedUploadMissions.Count > 0) then
- begin
- Exit;
- end;
- if Copy(Item.LoginName, 1, 1) = 'D' then
- begin
- ADirectory := TRealICQNetWorkDiskDirectory(Item.Data);
- RealICQNetWorkDiskClient.GetDirectory(ADirectory);
- end
- else if Copy(Item.LoginName, 1, 1) = 'F' then
- begin
- AFile := TRealICQNetWorkDiskFile(Item.Data);
- MainForm.FormStyle := fsNormal;
- try
- DownloadFileSaveDialog.FileName := AFile.Name;
- if DownloadFileSaveDialog.Execute then
- begin
- AddDownloadMission(mtFile, ExtractFilePath(DownloadFileSaveDialog.FileName), AFile.ID, DownloadFileSaveDialog.FileName, True);
- end;
- finally
- // if MainForm.AlwaysOnTop then
- // MainForm.FormStyle := fsStayOnTop
- // else
- // MainForm.FormStyle := fsNormal;
- end;
- end;
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.RealICQNetWorkDiskClientDeleteResult(Sender: TObject; AList: string);
- var
- AStringList: TStringList;
- iLoop, iIndex: Integer;
- begin
- AStringList := SplitString(AList, Chr(10));
- FLVNetWorkDisk.DisableAlign;
- try
- for iLoop := 0 to AStringList.Count - 1 do
- begin
- iIndex := FLVNetWorkDisk.Items.IndexOf(AStringList.Strings[iLoop]);
- if iIndex >= 0 then
- FLVNetWorkDisk.Items.Delete(iIndex);
- end;
- finally
- FLVNetWorkDisk.EnableAlign;
- FreeAndNil(AStringList);
- lblNDState.Caption := Format('目录: %d 文件: %d', [RealICQNetWorkDiskClient.CurrentDirectory.Directories.Count, RealICQNetWorkDiskClient.CurrentDirectory.Files.Count]);
- ShowNetWorkDiskSpaceInfo;
- NDSelectItemChanged(nil);
- end;
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.RealICQNetWorkDiskClientDirectoryListReady(Sender: TObject);
- var
- iLoop, ItemIndex: Integer;
- AFile: TRealICQNetWorkDiskFile;
- ADirectory: TRealICQNetWorkDiskDirectory;
- ListItem: TRealICQContacterListItem;
- Bitmap: TBitmap;
- UploadMission: TUploadMission;
- NDDirName: string;
- begin
- spbNDMoveUp.Enabled := (not pnlNDMissions.Visible) and (RealICQNetWorkDiskClient.CurrentDirectory.Parent <> nil) and (RealICQNetWorkDiskClient.Connected);
- edNDDir.Text := '';
- ADirectory := RealICQNetWorkDiskClient.CurrentDirectory;
- while ADirectory <> nil do
- begin
- edNDDir.Text := ADirectory.Name + '\' + edNDDir.Text;
- ADirectory := ADirectory.Parent;
- end;
- try
- FLVNetWorkDisk.AdjustPosition := False;
- FLVNetWorkDisk.DisableAlign;
- FLVNetWorkDisk.Items.Clear;
- NDSelectItemChanged(nil);
- for iLoop := 0 to RealICQNetWorkDiskClient.CurrentDirectory.Directories.Count - 1 do
- begin
- ADirectory := TRealICQNetWorkDiskDirectory(RealICQNetWorkDiskClient.CurrentDirectory.Directories[iLoop]);
- ItemIndex := FLVNetWorkDisk.Items.Add('D' + IntToStr(ADirectory.ID));
- ListItem := FLVNetWorkDisk.Items.Objects[ItemIndex] as TRealICQContacterListItem;
- with ListItem do
- begin
- LoginState := stOnline;
- Data := ADirectory;
- DisplayName := ADirectory.Name;
- end;
- lblNDState.Caption := Format('载入... 目录: %d/%d 文件: %d/%d', [iLoop + 1, RealICQNetWorkDiskClient.CurrentDirectory.Directories.Count, 0, RealICQNetWorkDiskClient.CurrentDirectory.Files.Count]);
- lblNDState.Update;
- end;
- for iLoop := 0 to RealICQNetWorkDiskClient.CurrentDirectory.Files.Count - 1 do
- begin
- AFile := TRealICQNetWorkDiskFile(RealICQNetWorkDiskClient.CurrentDirectory.Files[iLoop]);
- ItemIndex := FLVNetWorkDisk.Items.Add('F' + IntToStr(AFile.ID));
- ListItem := FLVNetWorkDisk.Items.Objects[ItemIndex] as TRealICQContacterListItem;
- with ListItem do
- begin
- LoginState := stLeave;
- Data := AFile;
- DisplayName := AFile.Name;
- if AFile.Size >= 1024 * 1024 then
- Watchword := Format('%0.1fMB', [AFile.Size / (1024 * 1024)])
- else if AFile.Size >= 1024 then
- Watchword := IntToStr(AFile.Size div 1024) + 'KB'
- else
- Watchword := IntToStr(AFile.Size) + 'B';
- try
- HeadImagePicture.LoadFromFile(GetBitmapFromFileExt(AFile.Name));
- except
- end;
- FreeAndNil(Bitmap);
- end;
- lblNDState.Caption := Format('载入... 目录: %d/%d 文件: %d/%d', [RealICQNetWorkDiskClient.CurrentDirectory.Directories.Count, RealICQNetWorkDiskClient.CurrentDirectory.Directories.Count, iLoop + 1, RealICQNetWorkDiskClient.CurrentDirectory.Files.Count]);
- lblNDState.Update;
- end;
- finally
- FLVNetWorkDisk.ReDrawAll;
- FLVNetWorkDisk.EnableAlign;
- FLVNetWorkDisk.AdjustPosition := True;
- lblNDState.Caption := Format('目录: %d 文件: %d', [RealICQNetWorkDiskClient.CurrentDirectory.Directories.Count, RealICQNetWorkDiskClient.CurrentDirectory.Files.Count]);
- end;
- if FLVNetWorkDiskUploadingFiles.Items.Count > 0 then
- begin
- ListItem := FLVNetWorkDiskUploadingFiles.Items.Objects[0] as TRealICQContacterListItem;
- UploadMission := TUploadMission(ListItem.Data);
- if UploadMission.UploadMissionType = mtDir then
- begin
- if Length(ExtractFileName(UploadMission.Name)) = 0 then
- NDDirName := '[' + Copy(UploadMission.Name, 1, 1) + ']'
- else
- NDDirName := ExtractFileName(UploadMission.Name);
- if AnsiSameText(NDDirName, RealICQNetWorkDiskClient.CurrentDirectory.Name) and (RealICQNetWorkDiskClient.CurrentDirectory.ParentID = UploadMission.DirectoryID) then
- begin
- try
- FLVNetWorkDiskUploadingFiles.Items.Delete(0);
- except
- end;
- try
- GoNextLevelUploadMissions(UploadMission);
- finally
- FreeAndNil(UploadMission);
- end;
- Exit;
- end;
- end;
- end;
- if Length(Trim(FLastDownloadDirectory)) > 0 then
- begin
- if (DirectoryExists(FLastDownloadDirectory)) then
- begin
- for iLoop := 0 to FLVNetWorkDisk.Items.Count - 1 do
- begin
- ListItem := FLVNetWorkDisk.Items.Objects[iLoop] as TRealICQContacterListItem;
- if Copy(ListItem.LoginName, 1, 1) = 'D' then
- begin
- ADirectory := TRealICQNetWorkDiskDirectory(ListItem.Data);
- AddDownloadMission(mtDir, FLastDownloadDirectory + '\' + ADirectory.Name, 0, '', False);
- end
- else
- begin
- AFile := TRealICQNetWorkDiskFile(ListItem.Data);
- AddDownloadMission(mtFile, ExtractFilePath(FLastDownloadDirectory), AFile.ID, FLastDownloadDirectory + '\' + AFile.Name, False);
- end;
- end; //for
- CheckDownloadMissions;
- end;
- end;
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.RealICQNetWorkDiskClientDownloadFileAborted(Sender: TObject; AFileDownloader: TRealICQNWDFileDownloader);
- begin
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.RealICQNetWorkDiskClientDownloadFileCompleted(Sender: TObject; AFileDownloader: TRealICQNWDFileDownloader);
- var
- ListItem: TRealICQContacterListItem;
- DownloadMission: TDownloadMission;
- MessageBoxResult: Integer;
- begin
- if not RealICQNetWorkDiskClient.Connected then
- Exit;
- try
- if FLVNetWorkDiskDownloadingFiles.Items.Count > 0 then
- begin
- ListItem := FLVNetWorkDiskDownloadingFiles.Items.Objects[0] as TRealICQContacterListItem;
- DownloadMission := TDownloadMission(ListItem.Data);
- if DownloadMission.FFileID = AFileDownloader.FileID then
- begin
- if not AFileDownloader.Completed then
- begin
- if AFileDownloader.Exp <> nil then
- begin
- MessageBoxResult := MessageBox(Handle, PChar('下载文件时出错：'#$D#$A#$D#$A + AFileDownloader.Exp.Message), '提示', MB_ICONERROR or MB_ABORTRETRYIGNORE);
- if MessageBoxResult = ID_ABORT then
- begin
- spbNDCancelAllClick(spbNDCancelAll);
- Exit;
- end
- else if MessageBoxResult = ID_RETRY then
- begin
- CheckDownloadMissions;
- Exit;
- end
- else if MessageBoxResult = ID_IGNORE then
- begin
- end;
- end;
- end;
- FLVNetWorkDiskDownloadingFiles.Items.Delete(0);
- FreeAndNil(DownloadMission);
- end;
- end;
- except
- end;
- CheckDownloadMissions;
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.RealICQNetWorkDiskClientDownloadFileTransmitting(Sender: TObject; AFileDownloader: TRealICQNWDFileDownloader);
- var
- ListItem: TRealICQContacterListItem;
- Completed: Integer;
- ASpeed: Cardinal;
- SpeedStr: string;
- begin
- if FLVNetWorkDiskDownloadingFiles.Items.Count > 0 then
- begin
- ListItem := FLVNetWorkDiskDownloadingFiles.Items.Objects[0] as TRealICQContacterListItem;
- with ListItem do
- begin
- Completed := AFileDownloader.RecvedSize * 100 div AFileDownloader.FileSize;
- try
- ASpeed := Round(AFileDownloader.RecvedSize div ((GetTickCount - AFileDownloader.StartTicket) div 1000) * 1.2);
- except
- Exit;
- end;
- if ASpeed > 1000 * 1000 then
- SpeedStr := Format('%0.1fMB/秒', [ASpeed / (1000 * 1000)])
- else if ASpeed > 1000 then
- SpeedStr := Format('%0.1fKB/秒', [ASpeed / 1000])
- else
- SpeedStr := Format('%d字节/秒', [ASpeed]);
- DisplayName := '(' + IntToStr(Completed) + '%，' + SpeedStr + ')';
- DisplayName := DisplayName + (AFileDownloader.LocalFileName);
- ReDrawItem;
- end;
- end;
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.RealICQNetWorkDiskClientGettedUsedSpaceSize(Sender: TObject);
- begin
- ShowNetWorkDiskSpaceInfo;
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.RealICQNetWorkDiskClientLoginFailed(Sender: TObject; E: Exception);
- begin
- lblNDState.Caption := '连接失败（' + E.Message + '）';
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.RealICQNetWorkDiskClientLoginResult(Sender: TObject; LoginResultType: Byte);
- begin
- if LoginResultType = 0 then
- begin
- RealICQNetWorkDiskClient.GetDirectory(RealICQNetWorkDiskClient.CurrentDirectory);
- end
- else if LoginResultType = 1 then
- begin
- lblNDState.Caption := '连接失败，服务器版本错误';
- end
- else if LoginResultType = 2 then
- begin
- lblNDState.Caption := '连接失败，用户验证错误';
- end;
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.RealICQClientBeDropped(Sender: TObject; Excuse: string);
- begin
- MessageBox(Handle, PChar(Excuse), '你已被强制下线', MB_ICONINFORMATION or MB_OK);
- TTeamsAdapter.Stop;
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.RealICQClientDownloadFile(Sender: TObject; AFileName: string);
- var
- iLoop: Integer;
- WebPanel: TWebPanel;
- TabSheet: TTabSheet;
- Bitmap: TBitmap;
- begin
- for iLoop := 0 to FWebTabs.Count - 1 do
- begin
- TabSheet := FWebTabs[iLoop];
- WebPanel := FWebPanels.Objects[iLoop] as TWebPanel;
- if AnsiSameText(WebPanel.Image, AFileName) then
- begin
- Bitmap := TBitmap.Create;
- try
- try
- Bitmap.LoadFromFile(AFileName);
- Bitmap.SetSize(ImgLstPageControl.Width, ImgLstPageControl.Height);
- ImgLstPageControl.Add(Bitmap, Bitmap);
- TabSheet.ImageIndex := ImgLstPageControl.Count - 1;
- except
- end;
- finally
- FreeAndNil(Bitmap);
- end;
- end;
- end;
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.RealICQClientDownloadTeamFace(Sender: TObject; AFileName: string);
- begin
- ShowGettedFace(AFileName);
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.RealICQClientLoginFailed(Sender: TObject; E: Exception);
- begin
- TimerForLogining.Enabled := False;
- SetUIState;
- MessageBox(Handle, PChar('抱歉，您现在无法登录至服务器： ' + E.Message), '登录失败', MB_ICONINFORMATION or MB_OK);
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.actShowLoginNameExecute(Sender: TObject);
- var
- iLoop: Integer;
- RealICQContacterListView: TRealICQContacterListView;
- RealICQContacterTreeView: TRealICQContacterTreeView;
- begin
- for iLoop := 0 to FContacterListViews.Count - 1 do
- begin
- RealICQContacterListView := FContacterListViews.Objects[iLoop] as TRealICQContacterListView;
- RealICQContacterListView.CaptionStyle := csLoginName;
- end;
- for iLoop := 0 to FContacterTreeViews.Count - 1 do
- begin
- RealICQContacterTreeView := FContacterTreeViews.Objects[iLoop] as TRealICQContacterTreeView;
- RealICQContacterTreeView.CaptionStyle := csLoginName;
- RealICQContacterTreeView.ReDrawAll;
- end;
- FLVCaptionStyle := csLoginName;
- SaveStyleConfigs;
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.actShowDisplayNameExecute(Sender: TObject);
- var
- iLoop: Integer;
- RealICQContacterListView: TRealICQContacterListView;
- RealICQContacterTreeView: TRealICQContacterTreeView;
- begin
- for iLoop := 0 to FContacterListViews.Count - 1 do
- begin
- RealICQContacterListView := FContacterListViews.Objects[iLoop] as TRealICQContacterListView;
- RealICQContacterListView.CaptionStyle := csDisplayName;
- end;
- for iLoop := 0 to FContacterTreeViews.Count - 1 do
- begin
- RealICQContacterTreeView := FContacterTreeViews.Objects[iLoop] as TRealICQContacterTreeView;
- RealICQContacterTreeView.CaptionStyle := csDisplayName;
- RealICQContacterTreeView.ReDrawAll;
- end;
- FLVCaptionStyle := csDisplayName;
- SaveStyleConfigs;
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.actShowGIFInMailFormExecute(Sender: TObject);
- begin
- actShowGIFInMailForm.Checked := not actShowGIFInMailForm.Checked;
- FShowGIFInMailForm := actShowGIFInMailForm.Checked;
- SaveStyleConfigs;
- if RealICQClient.Me = nil then
- Exit;
- if RealICQClient.Me.HeadImageFileType = htGIF then
- begin
- ShowMeInformation;
- end;
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.actShowGIFInTalkingFormExecute(Sender: TObject);
- begin
- actShowGIFInTalkingForm.Checked := not actShowGIFInTalkingForm.Checked;
- FShowGIFInTalkingForm := actShowGIFInTalkingForm.Checked;
- SaveStyleConfigs;
- UpdateAllTakingFormGIFHeadImage;
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.actShowGroupExecute(Sender: TObject);
- begin
- FShowGroup := not FShowGroup;
- actShowGroup.Checked := FShowGroup;
- SaveIfShowGroupConfig;
- ShowGroupInterface;
- end;
- //------------------------------------------------------------------------------
- function TMainForm.GetSelectedLoginName: string;
- var
- GroupIndex, iLoop: Integer;
- GroupName: string;
- ListView: TRealICQContacterListView;
- ListItem: TRealICQContacterListItem;
- ItemIndex: Integer;
- RealICQFriendTreeView: TRealICQContacterTreeView;
- RealICQContacterTreeView: TRealICQContacterTreeView;
- Employee: TRealICQEmployee;
- Friend: TRealICQEmployee;
- begin
- Result := '';
- if FSearchListViewInVisible then
- begin
- for iLoop := 0 to FSearchListView.Items.Count - 1 do
- begin
- ListItem := FSearchListView.Items.Objects[iLoop] as TRealICQContacterListItem;
- if ListItem.Selected then
- begin
- Result := ListItem.LoginName;
- Exit;
- end;
- end;
- end;
- GroupName := GetActiveTabSheetName;
- if GroupName = LVMyContacters then
- begin
- ItemIndex := FContacterTreeViews.IndexOf(LVMyContacters);
- RealICQContacterTreeView := FContacterTreeViews.Objects[ItemIndex] as TRealICQContacterTreeView;
- Employee := RealICQContacterTreeView.GetSelectedEmployee;
- if Employee <> nil then
- begin
- Result := Employee.LoginName;
- end;
- Exit;
- end;
- if GroupName = LVMoreUsers then
- begin
- ItemIndex := FContacterTreeViews.IndexOf(LVMoreUsers);
- RealICQContacterTreeView := FContacterTreeViews.Objects[ItemIndex] as TRealICQContacterTreeView;
- Employee := RealICQContacterTreeView.GetSelectedEmployee;
- if Employee <> nil then
- begin
- Result := Employee.LoginName;
- end;
- Exit;
- end;
- if GroupName = LVFriends then
- begin
- ItemIndex := FContacterTreeViews.IndexOf(LVFriends);
- RealICQFriendTreeView := FContacterTreeViews.Objects[ItemIndex] as TRealICQContacterTreeView;
- Friend := RealICQFriendTreeView.GetSelectedEmployee;
- if Friend <> nil then
- begin
- Result := Friend.LoginName;
- end;
- Exit;
- end;
- GroupIndex := FContacterListViews.IndexOf(GroupName);
- ListView := FContacterListViews.Objects[GroupIndex] as TRealICQContacterListView;
- for iLoop := 0 to ListView.Items.Count - 1 do
- begin
- ListItem := ListView.Items.Objects[iLoop] as TRealICQContacterListItem;
- if ListItem.Selected then
- begin
- Result := ListItem.LoginName;
- Break;
- end;
- end;
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.actShowHistoryExecute(Sender: TObject);
- var
- LoginName: string;
- begin
- LoginName := GetSelectedLoginName;
- if LoginName <> '' then
- begin
- OpenMessagesManagerForm;
- Application.ProcessMessages;
- MessagesManagerForm.ShowUsersMessages(LoginName);
- end;
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.actSeeInformationExecute(Sender: TObject);
- var
- LoginName: string;
- begin
- LoginName := GetSelectedLoginName;
- if LoginName <> '' then
- begin
- SeeUserInformation(LoginName);
- end;
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.actChangeRemarkExecute(Sender: TObject);
- var
- LoginName: string;
- Remark: string;
- RealICQUser: TRealICQUser;
- begin
- LoginName := GetSelectedLoginName;
- if LoginName <> '' then
- begin
- RealICQUser := TUsersService.GetUsersService.GetOrRequestUser(LoginName);
- if RealICQUser = nil then
- Exit;
- if (RealICQUser.LoginName = RealICQClient.Me.LoginName) then
- begin
- ShowMessage('不允许修改自己的备注名称！');
- Exit;
- end;
- Remark := RealICQUser.Remark;
- Remark := Trim(ShowMyInputBox('修改备注名称', '新备注名称', RealICQUser.Remark, 50));
- if not AnsiSameStr(Remark, RealICQUser.Remark) then
- RealICQClient.ChangeRemark(LoginName, Remark);
- end;
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.actSendMessageExecute(Sender: TObject);
- var
- LoginName: string;
- begin
- LoginName := GetSelectedLoginName;
- if LoginName <> '' then
- begin
- if AnsiSameText(LoginName, RealICQClient.LoginName) then
- begin
- MessageBox(Handle, '对不起，不可以和自己对话！', '提示', MB_ICONINFORMATION);
- Exit;
- end;
- //----------------------------------------
- {if GetActiveTabSheetName=MoreUser then
- begin
- RealICQClient.GetUserInformation(LoginName,True);
- end;}
- OpenTalkingForm(LoginName);
- end;
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.actSendTeamMessageExecute(Sender: TObject);
- var
- iLoop: Integer;
- ListItem: TRealICQContacterListItem;
- RealICQTeam: TRealICQTeam;
- begin
- if FLVTeams.SelCount = 1 then
- begin
- for iLoop := 0 to FLVTeams.Items.Count - 1 do
- begin
- ListItem := FLVTeams.Items.Objects[iLoop] as TRealICQContacterListItem;
- if ListItem.Selected then
- begin
- RealICQTeam := ListItem.Data;
- OpenTeamTalkingForm(RealICQTeam.TeamID);
- Break;
- end;
- end;
- end;
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.actSeeTeamInformationExecute(Sender: TObject);
- var
- iLoop: Integer;
- ListItem: TRealICQContacterListItem;
- RealICQTeam: TRealICQTeam;
- begin
- if FLVTeams.SelCount = 1 then
- begin
- for iLoop := 0 to FLVTeams.Items.Count - 1 do
- begin
- ListItem := FLVTeams.Items.Objects[iLoop] as TRealICQContacterListItem;
- if ListItem.Selected then
- begin
- RealICQTeam := ListItem.Data;
- OpenTeamOptionsForm(RealICQTeam);
- Break;
- end;
- end;
- end;
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.actQuitTeamExecute(Sender: TObject);
- var
- iLoop: Integer;
- ListItem: TRealICQContacterListItem;
- RealICQTeam: TRealICQTeam;
- begin
- if FLVTeams.SelCount = 1 then
- begin
- for iLoop := 0 to FLVTeams.Items.Count - 1 do
- begin
- ListItem := FLVTeams.Items.Objects[iLoop] as TRealICQContacterListItem;
- if ListItem.Selected then
- begin
- RealICQTeam := ListItem.Data;
- if MessageBox(Handle, '真的要退出该群组吗?', '提示', MB_ICONINFORMATION or MB_OKCANCEL) <> ID_OK then
- Exit;
- TTeamsAdapter.QuitTeam(RealICQTeam.TeamID);
- Break;
- end;
- end;
- end;
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.actDisbandTeamExecute(Sender: TObject);
- var
- iLoop: Integer;
- ListItem: TRealICQContacterListItem;
- RealICQTeam: TRealICQTeam;
- begin
- {if FLVTeams.SelCount = 1 then
- begin
- for iLoop := 0 to FLVTeams.Items.Count - 1 do
- begin
- ListItem := FLVTeams.Items.Objects[iLoop] as TRealICQContacterListItem;
- if ListItem.Selected then
- begin
- RealICQTeam := ListItem.Data;
- if MessageBox(Handle, '真的要解散该群组吗?', '提示', MB_ICONINFORMATION or MB_OKCANCEL) <> ID_OK then Exit;
- RealICQClient.DisbandTeam(RealICQTeam.TeamID);
- Break;
- end;
- end;
- end; }
- if FLVTeams.SelCount = 1 then
- begin
- for iLoop := 0 to FLVTeams.Items.Count - 1 do
- begin
- ListItem := FLVTeams.Items.Objects[iLoop] as TRealICQContacterListItem;
- if ListItem.Selected then
- begin
- RealICQTeam := ListItem.Data;
- if MessageBox(Handle, '真的要解散该群组吗?', '提示', MB_ICONINFORMATION or MB_OKCANCEL) <> ID_OK then
- Exit;
- TTeamsAdapter.DisbandTeam(RealICQTeam.TeamID);
- Break;
- end;
- end;
- end;
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.actQuitOrDisbandTeamsExecute(Sender: TObject);
- var
- iLoop: Integer;
- ListItem: TRealICQContacterListItem;
- RealICQTeam: TRealICQTeam;
- begin
- if MessageBox(Handle, '真的要退出 / 解散选中的群组吗?', '提示', MB_ICONINFORMATION or MB_OKCANCEL) <> ID_OK then
- Exit;
- for iLoop := 0 to FLVTeams.Items.Count - 1 do
- begin
- ListItem := FLVTeams.Items.Objects[iLoop] as TRealICQContacterListItem;
- if ListItem.Selected then
- begin
- RealICQTeam := ListItem.Data;
- if AnsiSameText(RealICQTeam.TeamCreater, RealICQClient.LoginName) then
- RealICQClient.DisbandTeam(RealICQTeam.TeamID)
- else
- RealICQClient.QuitTeam(RealICQTeam.TeamID);
- end;
- end;
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.actShowAllNameExecute(Sender: TObject);
- var
- iLoop: Integer;
- RealICQContacterListView: TRealICQContacterListView;
- RealICQContacterTreeView: TRealICQContacterTreeView;
- begin
- for iLoop := 0 to FContacterListViews.Count - 1 do
- begin
- RealICQContacterListView := FContacterListViews.Objects[iLoop] as TRealICQContacterListView;
- RealICQContacterListView.CaptionStyle := csDisplayNameAndLoginName;
- end;
- for iLoop := 0 to FContacterTreeViews.Count - 1 do
- begin
- RealICQContacterTreeView := FContacterTreeViews.Objects[iLoop] as TRealICQContacterTreeView;
- RealICQContacterTreeView.CaptionStyle := csDisplayNameAndLoginName;
- RealICQContacterTreeView.ReDrawAll;
- end;
- FLVCaptionStyle := csDisplayNameAndLoginName;
- SaveStyleConfigs;
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.actShowBigHeadImageExecute(Sender: TObject);
- var
- iLoop: Integer;
- RealICQContacterListView: TRealICQContacterListView;
- RealICQContacterTreeView: TRealICQContacterTreeView;
- begin
- for iLoop := 0 to FContacterListViews.Count - 1 do
- begin
- RealICQContacterListView := FContacterListViews.Objects[iLoop] as TRealICQContacterListView;
- RealICQContacterListView.Style := lsBigHeadImage;
- end;
- for iLoop := 0 to FContacterTreeViews.Count - 1 do
- begin
- RealICQContacterTreeView := FContacterTreeViews.Objects[iLoop] as TRealICQContacterTreeView;
- RealICQContacterTreeView.Style := lsBigHeadImage;
- RealICQContacterTreeView.ReDrawAll;
- end;
- FLVStyle := lsBigHeadImage;
- SaveStyleConfigs;
- end;
- procedure TMainForm.actShowMiddleHeadImageExecute(Sender: TObject);
- var
- iLoop: Integer;
- RealICQContacterListView: TRealICQContacterListView;
- RealICQContacterTreeView: TRealICQContacterTreeView;
- begin
- for iLoop := 0 to FContacterListViews.Count - 1 do
- begin
- RealICQContacterListView := FContacterListViews.Objects[iLoop] as TRealICQContacterListView;
- RealICQContacterListView.Style := lsMiddleHeadImage;
- end;
- for iLoop := 0 to FContacterTreeViews.Count - 1 do
- begin
- RealICQContacterTreeView := FContacterTreeViews.Objects[iLoop] as TRealICQContacterTreeView;
- RealICQContacterTreeView.Style := lsMiddleHeadImage;
- RealICQContacterTreeView.ReDrawAll;
- end;
- FLVStyle := lsMiddleHeadImage;
- SaveStyleConfigs;
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.actShowSmallHeadImageExecute(Sender: TObject);
- var
- iLoop: Integer;
- RealICQContacterListView: TRealICQContacterListView;
- RealICQContacterTreeView: TRealICQContacterTreeView;
- begin
- for iLoop := 0 to FContacterListViews.Count - 1 do
- begin
- RealICQContacterListView := FContacterListViews.Objects[iLoop] as TRealICQContacterListView;
- RealICQContacterListView.Style := lsSmallHeadImage;
- end;
- for iLoop := 0 to FContacterTreeViews.Count - 1 do
- begin
- RealICQContacterTreeView := FContacterTreeViews.Objects[iLoop] as TRealICQContacterTreeView;
- RealICQContacterTreeView.Style := lsSmallHeadImage;
- RealICQContacterTreeView.ReDrawAll;
- end;
- FLVStyle := lsSmallHeadImage;
- SaveStyleConfigs;
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.actShowStrangersExecute(Sender: TObject);
- begin
- // SaveStyleConfigs;
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.actShowBlacklistsExecute(Sender: TObject);
- begin
- // SaveStyleConfigs;
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.actShowTeamHistoryExecute(Sender: TObject);
- var
- iLoop: Integer;
- ListItem: TRealICQContacterListItem;
- RealICQTeam: TRealICQTeam;
- begin
- if FLVTeams.SelCount = 1 then
- begin
- for iLoop := 0 to FLVTeams.Items.Count - 1 do
- begin
- ListItem := FLVTeams.Items.Objects[iLoop] as TRealICQContacterListItem;
- if ListItem.Selected then
- begin
- RealICQTeam := ListItem.Data;
- OpenMessagesManagerForm;
- Application.ProcessMessages;
- MessagesManagerForm.ShowTeamsMessages(RealICQTeam.TeamID);
- Break;
- end;
- end;
- end;
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.actShowTeamsExecute(Sender: TObject);
- begin
- // SaveStyleConfigs;
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.actShowTreeExecute(Sender: TObject);
- begin
- FShowTree := not FShowTree;
- actShowTree.Checked := FShowTree;
- actShowBigHeadImage.Visible := not actShowTree.Checked;
- actShowMiddleHeadImage.Visible := not actShowTree.Checked;
- if FShowTree then
- begin
- if FLVStyle <> lsNoHeadImage then
- begin
- FLVStyle := lsSmallHeadImage;
- actShowSmallHeadImage.Execute;
- end;
- end;
- SaveStyleConfigs;
- ShowGroupInterface;
- end;
- //------------------------------------------------------------------------------
- //------------------------------------------------------------------------------
- procedure TMainForm.actAboutExecute(Sender: TObject);
- begin
- AboutForm := TAboutForm.Create(Self);
- try
- AboutForm.ShowModal;
- finally
- FreeAndNil(AboutForm);
- end;
- end;
- procedure TMainForm.actAlwaysOnTopExecute(Sender: TObject);
- begin
- if FAlwaysOnTop then
- SetOnTop(Handle, True)
- else
- SetOnTop(Handle, False);
- actAlwaysOnTop.Checked := FAlwaysOnTop;
- SaveDefaultConfigs;
- end;
- procedure TMainForm.actShowNormalHeadImageExecute(Sender: TObject);
- var
- iLoop: Integer;
- RealICQContacterListView: TRealICQContacterListView;
- RealICQContacterTreeView: TRealICQContacterTreeView;
- begin
- for iLoop := 0 to FContacterListViews.Count - 1 do
- begin
- RealICQContacterListView := FContacterListViews.Objects[iLoop] as TRealICQContacterListView;
- RealICQContacterListView.Style := lsNoHeadImage;
- end;
- for iLoop := 0 to FContacterTreeViews.Count - 1 do
- begin
- RealICQContacterTreeView := FContacterTreeViews.Objects[iLoop] as TRealICQContacterTreeView;
- RealICQContacterTreeView.Style := lsNoHeadImage;
- RealICQContacterTreeView.ReDrawAll;
- end;
- FLVStyle := lsNoHeadImage;
- SaveStyleConfigs;
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.actShowRemarkExecute(Sender: TObject);
- var
- iLoop, jLoop: Integer;
- RealICQContacterListView: TRealICQContacterListView;
- RealICQContacterTreeView: TRealICQContacterTreeView;
- RealICQContacterListItem: TRealICQContacterListItem;
- RealICQUser: TRealICQUser;
- Employee: TRealICQEmployee;
- begin
- actShowRemark.Checked := not actShowRemark.Checked;
- RealICQClient.ShowRemark := actShowRemark.Checked;
- for iLoop := 0 to FContacterListViews.Count - 1 do
- begin
- RealICQContacterListView := FContacterListViews.Objects[iLoop] as TRealICQContacterListView;
- for jLoop := 0 to RealICQContacterListView.Items.Count - 1 do
- begin
- RealICQContacterListItem := RealICQContacterListView.Items.Objects[jLoop] as TRealICQContacterListItem;
- RealICQUser := RealICQContacterListItem.Data;
- //BindUserDataToItem(RealICQContacterListItem, RealICQUser);
- TUsersService.GetUsersService.UpdateListItem(RealICQContacterListView, RealICQContacterListItem, RealICQUser);
- end;
- end;
- for iLoop := 0 to FContacterTreeViews.Count - 1 do
- begin
- RealICQContacterTreeView := FContacterTreeViews.Objects[iLoop] as TRealICQContacterTreeView;
- for jLoop := 0 to RealICQContacterTreeView.Count - 1 do
- begin
- Employee := RealICQContacterTreeView.EmployeeItems.Objects[jLoop] as TRealICQEmployee;
- RealICQUser := Employee.Data;
- //UpdateEmployeeNode(Employee, RealICQUser, False);
- TUsersService.GetUsersService.UpdateTreeNode(RealICQContacterTreeView, Employee, RealICQUser, False);
- end;
- RealICQContacterTreeView.ReDrawAll;
- end;
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.actFindUsersExecute(Sender: TObject);
- begin
- //非办公助手企业用户无查找用户权限
- if (FProductType <> ptBGZS) AND ((FUserType = utUnknown) OR (FUserType = utCompany)) then
- begin
- ShowMessage('您没有查找用户权限! ');
- Exit;
- end;
- if SearchForm <> nil then
- begin
- SearchForm.BringToFront;
- Exit;
- end;
- SearchForm := TSearchForm.Create(Application);
- SearchForm.Show;
- end;
- procedure TMainForm.actGroupManagerExecute(Sender: TObject);
- begin
- if GroupManagerForm <> nil then
- Exit;
- GroupManagerForm := TGroupManagerForm.Create(Self);
- try
- GroupManagerForm.ShowModal;
- finally
- FreeAndNil(GroupManagerForm);
- end;
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.OpenMessagesManagerForm;
- begin
- actMsgManagerExecute(nil);
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.pgcMainWorkAreaTabChanging(Sender: TObject; NewIndex: Integer; var AllowChanged: Boolean);
- var
- TabSheet: TTabSheet;
- WebPanel: TWebPanel;
- Point: TPoint;
- begin
- {if NewIndex = 1 then
- begin
- MainForm.RealICQClient.OnGettedAddrBookGroups:=GettedAddrBookGroups;
- MainForm.RealICQClient.OnManageAddrBookResult:=GettedManageAddrBookResult;
- RealICQClient.SendGetAddrBookGroup;
- end;}
- if NewIndex > 2 then
- begin
- AllowChanged := False;
- //if not DisplayWebs then Exit;
- TabSheet := pgcMainWorkArea.Pages[NewIndex];
- WebPanel := FWebPanels.Objects[TabSheet.Tag] as TWebPanel;
-
- //if WebPanel.FNavigateType = ntFill then AllowChanged := True;
- if WebPanel.Acounts.Count > 1 then
- begin
- if not ((Pos('[%', WebPanel.URL) <= 0) and (Pos('%]', WebPanel.URL) <= 0) and (Pos('[%', WebPanel.PostFields) <= 0) and (Pos('%]', WebPanel.PostFields) <= 0)) then
- begin
- Point.X := Mouse.CursorPos.X;
- Point.Y := Mouse.CursorPos.Y;
- FreeAndNil(SelWebTabAcountsForm);
- SelWebTabAcountsForm := TSelWebTabAcountsForm.Create(Self);
- SelWebTabAcountsForm.WebPanel := WebPanel;
- SelWebTabAcountsForm.TabSheet := TabSheet;
- SelWebTabAcountsForm.Left := Point.X;
- SelWebTabAcountsForm.Top := Point.Y - 20;
- if Left <= SelWebTabAcountsForm.Width then
- SelWebTabAcountsForm.Left := Left + Width
- else
- SelWebTabAcountsForm.Left := Left - SelWebTabAcountsForm.Width;
- if WebPanel.Acounts.Count < 10 then
- SelWebTabAcountsForm.pnlClient.Constraints.MinHeight := WebPanel.Acounts.Count * cntHeightOfBigHeadImage + 3
- else
- SelWebTabAcountsForm.pnlClient.Constraints.MinHeight := 10 * cntHeightOfBigHeadImage + 3;
- SelWebTabAcountsForm.pnlClient.Constraints.MaxHeight := SelWebTabAcountsForm.pnlClient.Constraints.MinHeight;
- SelWebTabAcountsForm.Show;
- Exit;
- end;
- end;
- WebTabShow(TabSheet);
- end;
- end;
- procedure TMainForm.pgcMainWorkAreaWebPanelButtonClick(Sender: TObject);
- begin
- pgcMainWorkArea.OnWebPanelButtonClick := nil;
- if OptionsForm = nil then
- OptionsForm := TOptionsForm.Create(Self);
- try
- OptionsForm.PageIndex := 10;
- OptionsForm.ShowModal;
- finally
- FreeAndNil(OptionsForm);
- pgcMainWorkArea.OnWebPanelButtonClick := pgcMainWorkAreaWebPanelButtonClick;
- end;
- end;
- //调整各标签位置
- procedure TMainForm.pnlToolBarResize(Sender: TObject);
- var
- AvgWidth: Integer;
- iLeft: Integer;
- begin
- //宁夏企业用户隐藏全市标签
- //if (FProductType = ptNXSQ) AND ((FUserType = utUnknown) OR (FUserType = utCompany)) then
- if (FProductType = ptNXSQ) AND ((FUserType = utUnknown) OR (FUserType = utCompany)) then
- begin
- SysMsg.Visible := False;
- SysMsgIcon.Visible := False;
- AvgWidth := (pnlToolBar.Width - 2) div 4;
- iLeft := 1;
- MyContacters.Left := iLeft;
- MyContacters.Width := AvgWidth;
- MyContactersIcon.Left := iLeft + (AvgWidth - MyContactersIcon.Width) div 2;
- iLeft := iLeft + AvgWidth;
- MyTeam.Left := iLeft;
- MyTeam.Width := AvgWidth;
- MyTeamIcon.Left := iLeft + (AvgWidth - MyTeamIcon.Width) div 2;
- iLeft := iLeft + AvgWidth;
- MyFriend.Left := iLeft;
- MyFriend.Width := AvgWidth;
- MyFriendIcon.Left := iLeft + (AvgWidth - MyFriendIcon.Width) div 2;
- iLeft := iLeft + AvgWidth;
- Latests.Left := iLeft;
- Latests.Width := pnlToolBar.Width - (AvgWidth * 3);
- LatestsIcon.Left := iLeft + (AvgWidth - LatestsIcon.Width) div 2;
- iLeft := iLeft + AvgWidth;
- end
- else
- begin
- SysMsg.Visible := True;
- SysMsgIcon.Visible := True;
- AvgWidth := (pnlToolBar.Width - 2) div 5;
- iLeft := 1;
- MyContacters.Left := iLeft;
- MyContacters.Width := AvgWidth;
- MyContactersIcon.Left := iLeft + (AvgWidth - MyContactersIcon.Width) div 2;
- iLeft := iLeft + AvgWidth;
- SysMsg.Left := iLeft;
- SysMsg.Width := AvgWidth;
- SysMsgIcon.Left := iLeft + (AvgWidth - SysMsgIcon.Width) div 2;
- iLeft := iLeft + AvgWidth;
- MyTeam.Left := iLeft;
- MyTeam.Width := AvgWidth;
- MyTeamIcon.Left := iLeft + (AvgWidth - MyTeamIcon.Width) div 2;
- iLeft := iLeft + AvgWidth;
- MyFriend.Left := iLeft;
- MyFriend.Width := AvgWidth;
- MyFriendIcon.Left := iLeft + (AvgWidth - MyFriendIcon.Width) div 2;
- iLeft := iLeft + AvgWidth;
- Latests.Left := iLeft;
- Latests.Width := pnlToolBar.Width - (AvgWidth * 4);
- LatestsIcon.Left := iLeft + (AvgWidth - LatestsIcon.Width) div 2;
- iLeft := iLeft + AvgWidth;
- end;
- end;
- {设置WebBrowser的样式}
- //------------------------------------------------------------------------------
- procedure TMainForm.SetDOMStyle(Doc: IHTMLDocument2);
- var
- CurrentColor, CssColor: string;
- begin
- try
- CurrentColor := IntToHex(ConvertColorToColor(FormColor, MainForm.UIMainColor), 6);
- CssColor := '#' + Copy(CurrentColor, 5, 2) + Copy(CurrentColor, 3, 2) + Copy(CurrentColor, 1, 2);
- Doc.body.style.cssText := 'word-break: break-all;';
- Doc.body.style.border := '0px solid';
- Doc.body.style.fontFamily := '宋体';
- Doc.body.style.fontSize := '9pt';
- Doc.body.style.margin := '0pt';
- Doc.body.setAttribute('scroll', 'no', 0);
- Doc.body.style.backgroundColor := CssColor;
- except
- end;
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.WebBrowserRightStatusTextChange(ASender: TObject; const Text: WideString);
- var
- TabSheet: TTabSheet;
- begin
- try
- TabSheet := ((ASender as TWebBrowser).Owner as TPanel).Owner as TTabSheet;
- if pgcMultiWeb.ActivePage = TabSheet then
- lblIEStatus.Caption := Text
- else
- lblIEStatus.Caption := '';
- except
- lblIEStatus.Caption := Text
- end;
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.WebBrowserRightTitleChange(ASender: TObject; const Text: WideString);
- var
- IETitle: WideString;
- TabSheet: TTabSheet;
- begin
- TabSheet := ((ASender as TWebBrowser).Owner as TPanel).Owner as TTabSheet;
- IETitle := Text;
-
- //字符串长度过长时,截短字符串并在后面显示“...”
- while TabSetMuiltWeb.Canvas.TextWidth(IETitle) > 138 do
- begin
- if Length(IETitle) > 3 then
- begin
- if Copy(IETitle, Length(IETitle) - 2, Length(IETitle)) = '...' then
- IETitle := Copy(IETitle, 1, Length(IETitle) - 3);
- IETitle := Copy(IETitle, 1, Length(IETitle) - 1) + '...';
- end
- else
- begin
- IETitle := '...';
- end;
- end;
- while TabSetMuiltWeb.Canvas.TextWidth(IETitle) < 88 do
- begin
- IETitle := IETitle + ' ';
- end;
- TabSetMuiltWeb.Tabs.Strings[TabSheet.TabIndex] := IETitle + ' ';
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.WebBrowserRightWindowClosing(ASender: TObject; IsChildWindow: WordBool; var Cancel: WordBool);
- var
- TabSheet: TTabSheet;
- WebBrowser: TWebBrowser;
- begin
- CoInitialize(nil);
- try
- WebBrowser := ASender as TWebBrowser;
- TabSheet := (WebBrowser.Owner as TPanel).Owner as TTabSheet;
- if pgcMultiWeb.PageCount > 1 then
- begin
- try
- if WebBrowser.Busy then
- WebBrowser.Stop;
- except
- end;
- TabSetMuiltWeb.Tabs.Delete(TabSheet.TabIndex);
- TabSheet.PageControl := nil;
- FreeAndNil(TabSheet);
- end
- else
- begin
- WebBrowser.OnDocumentComplete := WebBrowserRightDocumentComplete;
- WebBrowser.Navigate('about:blank');
- end;
- finally
- CoUninitialize;
- Cancel := True;
- end;
- end;
- {procedure TMainForm.WebSocketBroadCastMesssage(var msg: TMessage);
- var
- pdata: PBroadCastMessage;
- RealICQTeamMessage: TRealICQTeamMessage;
- begin
- showmessage(pdata.GroupID);
- RealICQTeamMessage:= TRealICQTeamMessage.Create(pdata.GroupID,pdata.Sayer,{pdata.Style}//'"宋体",9,[],[clBlack]',pdata.Msg,False);
- { RealICQTeamMessage.MessageID := gettickcount();
- RealICQTeamMessage.SendDateTime := pdata.timestamp;
- ShowRealICQTeamMessage(RealICQTeamMessage, False);
- end; }
- { TODO -olqq -c : WebSocket群通讯功能 2014/12/12 9:02:40 }
- procedure TMainForm.WebSocketJionTeamRequest(TeamID, ALoginName, ATag: string);
- var
- ATeam: TRealICQTeam;
- ATeamCaption: string;
- begin
- ATeam := TTeamsAdapter.GetTeam(TeamID);
- if ATeam <> nil then
- ATeamCaption := ATeam.TeamCaption;
- AddMessageHistory(smSimple, Format('%s 请求加入群组 %s<%s>。', [ALoginName, ATeamCaption, TeamID]), nil);
- ShowJoinTeamRequestWindow(Self, TeamID, ATeamCaption, ALoginName, ATag);
- end;
- procedure TMainForm.WebSocketQuitTeam(aTeamID: string);
- var
- iIndex: Integer;
- AlertMessage: string;
- ARealICQTeam: TRealICQTeam;
- AForm: TForm;
- begin
- iIndex := FLVTeams.Items.IndexOf(aTeamID);
- if iIndex >= 0 then
- begin
- ARealICQTeam := TTeamsAdapter.GetTeam(aTeamID);
- if ARealICQTeam = nil then
- Exit;
- FLVTeams.Items.Delete(iIndex);
- if ARealICQTeam.IsTempTeam then
- AlertMessage := '您 退出了 多人对话'
- else
- AlertMessage := '您 退出了群组: ' + ARealICQTeam.TeamCaption;
- ShowNotifyAlertForm(AlertMessage);
- AddMessageHistory(smSimple, AlertMessage, nil);
- CloseTeamOptionsForm(ARealICQTeam.TeamID);
- AForm := GetTeamTalkingForm(aTeamID);
- FreeAndNil(AForm);
- CloseJoinTeamRequestWindow(ARealICQTeam.TeamID);
- UpdateTeamTalkingForm(ARealICQTeam);
- end;
- end;
- procedure TMainForm.WebSocketRecivedbroadcastmesssage(aID, aGroupID, aSayer, aStyle, aMsg: string; aTimesTamp: TDateTime);
- var
- RealICQTeamMessage: TRealICQTeamMessage;
- aDateTime: TDateTime;
- begin
- RealICQTeamMessage := TRealICQTeamMessage.Create(aGroupID, aSayer, aStyle{'"宋体",9,[],[clBlack]'}, aMsg, False);
- RealICQTeamMessage.MessageID := gettickcount();
- RealICQTeamMessage.SendDateTime := aTimesTamp;
- ShowRealICQTeamMessage(RealICQTeamMessage, False);
- end;
- procedure TMainForm.WebSocketRemoveTeamResponse(aTeamID: string);
- var
- iIndex: Integer;
- AlertMessage: string;
- RealICQUser: TRealICQUser;
- ARealICQTeam: TRealICQTeam;
- AForm: TForm;
- begin
- iIndex := FLVTeams.Items.IndexOf(aTeamID);
- if iIndex >= 0 then
- begin
- FLVTeams.Items.Delete(iIndex);
- FLVTeams.ReDrawAll;
- ARealICQTeam := TTeamsAdapter.GetTeam(aTeamID);
- if ARealICQTeam = nil then
- Exit;
- RealICQUser := TUsersService.GetUsersService.GetOrRequestUser(ARealICQTeam.TeamCreater);
- if RealICQUser = RealICQClient.Me then
- AlertMessage := '您'
- else if RealICQUser.DisplayName = '' then
- AlertMessage := RealICQUser.LoginName
- else
- AlertMessage := RealICQUser.DisplayName;
- if ARealICQTeam.IsTempTeam then
- AlertMessage := AlertMessage + ' 解散了 多人对话'
- else
- AlertMessage := AlertMessage + ' 解散了群组: ' + ARealICQTeam.TeamCaption;
- ShowNotifyAlertForm(AlertMessage);
- AddMessageHistory(smSimple, AlertMessage, nil);
- CloseTeamOptionsForm(ARealICQTeam.TeamID);
- CloseJoinTeamRequestWindow(ARealICQTeam.TeamID);
- AForm := GetTeamTalkingForm(aTeamID);
- FreeAndNil(AForm);
- end;
- end;
- procedure TMainForm.WebSocketSendReadTeamInfo(aTeamID: string);
- var
- iLoop, iIndex: Integer;
- ListItem: TRealICQContacterListItem;
- MemberList: TStringList;
- ARealICQTeam: TRealICQTeam;
- begin
- ARealICQTeam := TTeamsAdapter.GetTeam(aTeamID);
- iIndex := FLVTeams.Items.IndexOf(ARealICQTeam.TeamID);
- if iIndex = -1 then
- iIndex := FLVTeams.Items.Add(ARealICQTeam.TeamID);
- ListItem := FLVTeams.Items.Objects[iIndex] as TRealICQContacterListItem;
- if ARealICQTeam.IsTempTeam then
- ListItem.Watchword := ''
- else
- ListItem.Watchword := ARealICQTeam.TeamIntro;
- ListItem.LoginState := stLeave;
- MemberList := SplitString(ARealICQTeam.TeamMembers, Chr(10));
- try
- for iLoop := MemberList.Count - 1 downto 0 do
- begin
- if Length(Trim(MemberList[iLoop])) = 0 then
- MemberList.Delete(iLoop);
- end;
- ListItem.LeaveMessage := IntToStr(MemberList.Count) + '个成员';
- finally
- MemberList.Free;
- end;
- {try
- ListItem.HeadImagePicture.LoadFromFile(ExtractFilePath(Application.ExeName) + TeamPicture);
- except
- ListItem.HeadImagePicture.Graphic := nil;
- end; }
- if ARealICQTeam.IsTempTeam then
- ListItem.DisplayName := '多人对话'
- else
- ListItem.DisplayName := ARealICQTeam.TeamCaption;
- ListItem.Data := ARealICQTeam;
- ListItem.ReDrawItem;
- UpdateTeamOptionsForm(ARealICQTeam);
- UpdateTeamTalkingForm(ARealICQTeam);
- end;
- { TODO -olqq -c : EndWebsocket 2014/12/12 9:05:23 }
- //------------------------------------------------------------------------------
- procedure TMainForm.WebBrowserRightNewWindow2(ASender: TObject; var ppDisp: IDispatch; var Cancel: WordBool);
- var
- WebBrowser1, WebBrowser: TWebBrowser;
- begin
- CoInitialize(nil);
- try
- try
- WebBrowser1 := ASender as TWebBrowser;
- if WebBrowser1.Busy then
- begin
- Cancel := True;
- Exit;
- end;
- WebBrowser := AddWebBrowserToPageControl('about:blank', -3);
- if WebBrowser = nil then
- begin
- Cancel := True;
- Exit;
- end;
- try
- if (WebBrowser.Busy) then
- WebBrowser.Stop;
- except
- end;
- ppDisp := WebBrowser.ControlInterface;
- except
- Cancel := True;
- end;
- finally
- CoUninitialize;
- end;
- end;
- //------------------------------------------------------------------------------
- function TMainForm.AddWebBrowserToPageControl(AUrl: string; WebPanelTag: Integer = -1): TWebBrowser;
- var
- TabSheet: TTabSheet;
- PanelForIE: TPanel;
- WebBrowser: TWebBrowser;
- begin
- if (WebPanelTag = -1) or (WebPanelTag = -3) or (pgcMultiWeb.PageCount <= 0) then
- begin
- TabSheet := TTabSheet.Create(pgcMultiWeb);
- try
- TabSheet.Parent := pgcMultiWeb;
- TabSheet.PageControl := pgcMultiWeb;
- TabSheet.DoubleBuffered := True;
- PanelForIE := TPanel.Create(TabSheet);
- PanelForIE.Parent := TabSheet;
- PanelForIE.DoubleBuffered := True;
- PanelForIE.Color := clWhite;
- PanelForIE.Align := alClient;
- PanelForIE.BevelInner := bvNone;
- PanelForIE.BevelOuter := bvNone;
- PanelForIE.Visible := True;
- PanelForIE.Padding.Left := 2;
- PanelForIE.Padding.Top := 2;
- PanelForIE.Padding.Right := 2;
- PanelForIE.Padding.Bottom := 2;
- WebBrowser := TWebBrowser.Create(PanelForIE);
- WebBrowser.DoubleBuffered := True;
- WebBrowser.ParentWindow := PanelForIE.Handle;
- WebBrowser.Align := alClient;
- WebBrowser.OnStatusTextChange := WebBrowserRightStatusTextChange;
- WebBrowser.OnTitleChange := WebBrowserRightTitleChange;
- WebBrowser.OnDocumentComplete := WebBrowserRightDocumentComplete;
- WebBrowser.OnNewWindow2 := WebBrowserRightNewWindow2;
- WebBrowser.OnWindowClosing := WebBrowserRightWindowClosing;
- WebBrowser.Tag := WebPanelTag;
- PanelForIE.InsertControl(WebBrowser);
- except
- TabSheet.PageControl := nil;
- FreeAndNil(TabSheet);
- Result := nil;
- Exit;
- end;
- TabSetMuiltWeb.Tabs.Add(AUrl + ' ');
- try
- TabSetMuiltWeb.TabIndex := TabSetMuiltWeb.Tabs.Count - 1;
- except
- end;
- pgcMultiWeb.ActivePageIndex := pgcMultiWeb.PageCount - 1;
- end
- else
- begin
- TabSheet := pgcMultiWeb.Pages[0];
- WebBrowser := (TabSheet.Controls[0] as TPanel).Controls[0] as TWebBrowser;
- WebBrowser.Tag := WebPanelTag;
- TabSetMuiltWeb.Tabs.Strings[0] := (AUrl + ' ');
- TabSetMuiltWeb.TabIndex := 0;
- pgcMultiWeb.ActivePageIndex := 0;
- end;
- {
- if not pnlMiddleRight.Visible then
- begin
- if RealICQClient.Logined and RealICQClient.Connected then
- begin
- ShowOrHideMuiltiWeb;
- end;
- end;
- try
- if (WebBrowser.Busy) then WebBrowser.Stop;
- except
- end;
-
- WebBrowser.OnDocumentComplete := WebBrowserRightDocumentComplete;
- //if not ((WebPanelTag = -3) and AnsiSameText(AUrl, 'about:blank')) then
- try
- WebBrowser.Navigate(AUrl);
- except
- end;
- Result := WebBrowser;
- }
- end;
- //------------------------------------------------------------------------------
- {
- procedure TMainForm.WebTabShow(Sender: TObject);
- var
- iIndex: Integer;
- TabSheet: TTabSheet;
- WebPanel: TWebPanel;
- WebURL: String;
- begin
- TabSheet := Sender as TTabSheet;
- //TabSheet.OnShow := nil;
-
- iIndex := FWebTabs.IndexOf(TabSheet);
- WebPanel := FWebPanels.Objects[iIndex] as TWebPanel;
- while TabSheet.ControlCount > 0 do
- begin
- TabSheet.Controls[0].Free;
- //TabSheet.RemoveControl(TabSheet.Controls[0]);
- end;
- if WebPanel.NavigateType = ntGET then
- begin
- WebURL := WebPanel.URL;
- if WebPanel.UserIMLoginName then
- WebURL := AnsiReplaceText(WebURL, '[%LoginName%]', RealICQClient.LoginName)
- else
- WebURL := AnsiReplaceText(WebURL, '[%LoginName%]', WebPanel.CustomLoginName);
- if WebPanel.UserIMPassword then
- WebURL := AnsiReplaceText(WebURL, '[%Password%]', RealICQClient.Password)
- else
- WebURL := AnsiReplaceText(WebURL, '[%Password%]', WebPanel.CustomPassword);
- AddWebBrowserToPageControl(WebUrl, iIndex);
- end
- else
- AddWebBrowserToPageControl('about:blank', iIndex);
- end;
- }
- //------------------------------------------------------------------------------
- //新Post方式
- procedure TMainForm.WebBrowserRightDocumentCompleteForPost(ASender: TObject; const pDisp: IDispatch; var URL: OleVariant);
- var
- WebBrowser: TWebBrowser;
- WebPanel: TWebPanel;
- WebTabAcount: TWebTabAcount;
- FieldName, ALoginName, FieldValue: string;
- PostFields, Field: TStringList;
- iLoop, jLoop, kLoop: Integer;
- WebItem: Olevariant;
- WebItemChild: Olevariant;
- WebItemForm: Olevariant;
- AFindedForm: Boolean;
- ASubmitID: string;
- begin
- WebBrowser := ASender as TWebBrowser;
- WebBrowser.OnDocumentComplete := nil;
- WebPanel := FWebPanels.Objects[WebBrowser.Tag] as TWebPanel;
- if WebPanel.Acounts.Count > 0 then
- WebTabAcount := WebPanel.Acounts[TabAcountIndex]
- else
- WebTabAcount := nil;
- ASubmitID := '';
- ;
- AFindedForm := False;
- PostFields := SplitString(WebPanel.PostFields, ',');
- try
- for kLoop := 0 to PostFields.Count - 1 do
- begin
- Field := SplitStringEx(PostFields.Strings[kLoop], '=');
- try
- try
- FieldName := Field.Strings[0];
- FieldValue := Field.Strings[1];
- if FieldName = 'LXTALK_SUBMIT_BTN' then
- ASubmitID := FieldValue;
- if WebTabAcount <> nil then
- begin
- FieldValue := AnsiReplaceText(FieldValue, '[%LoginName%]', WebTabAcount.LoginName);
- FieldValue := AnsiReplaceText(FieldValue, '[%Password%]', WebTabAcount.Password);
- FieldValue := AnsiReplaceText(FieldValue, '[%MD5_LoginName%]', MD5En(WebTabAcount.LoginName));
- FieldValue := AnsiReplaceText(FieldValue, '[%MD5_Password%]', MD5En(WebTabAcount.Password));
- end;
- WebBrowser.OleObject.Document.getElementByID(FieldName).value := FieldValue;
- //找到Form
- if not AFindedForm then
- begin
- WebItem := WebBrowser.Document;
- for iLoop := 0 to WebItem.Forms.length - 1 do
- begin
- //ShowMessage(WebItem.Forms.Item(iLoop, 0).name);
- WebItemChild := WebItem.Forms.Item(iLoop, 0);
- for jLoop := 0 to WebItemChild.all.length - 1 do
- begin
- if AnsiSameText(WebItemChild.all.item(jLoop).tagName, 'INPUT') then
- begin
- if AnsiSameText(WebItemChild.all.item(jLoop).name, FieldName) then
- begin
- AFindedForm := True;
- WebItemForm := WebItemChild;
- Break;
- end;
- //ShowMessage(WebItemChild.all.item(jLoop).tagName);
- //ShowMessage(WebItemChild.all.item(jLoop).type);
- //ShowMessage(WebItemChild.all.item(jLoop).name);
- end;
- end; //for
- end; //for
- end; //if
- except
- end;
- finally
- Field.Free;
- end;
- end;
- finally
- PostFields.Free;
- end;
- //ShowMessage(WebItemForm.Action);
- //Exit;
- WebItemForm.target := '_blank';
- //Exit;
- if ASubmitID <> '' then
- begin
- for jLoop := 0 to WebItemForm.all.length - 1 do
- begin
- if AnsiSameText(WebItemForm.all.item(jLoop).tagName, 'INPUT') then
- begin
- if AnsiSameText(WebItemForm.all.item(jLoop).name, ASubmitID) then
- begin
- WebItemForm.all.item(jLoop).click;
- end;
- end;
- end;
- end
- else
- begin
- for jLoop := 0 to WebItemForm.all.length - 1 do
- begin
- if AnsiSameText(WebItemForm.all.item(jLoop).tagName, 'INPUT') then
- begin
- if AnsiSameText(WebItemForm.all.item(jLoop).type, 'submit') then
- begin
- WebItemForm.all.item(jLoop).click;
- end;
- end;
- end;
- end;
- Application.ProcessMessages;
- Sleep(100);
- Application.ProcessMessages;
- //FreeAndNil(WebBrowser);
- end;
- //------------------------------------------------------------------------------
- //Get方式加旧版本Post方式
- procedure TMainForm.WebBrowserRightDocumentComplete(ASender: TObject; const pDisp: IDispatch; var URL: OleVariant);
- var
- PanelForIE: TPanel;
- WebBrowser: TWebBrowser;
- WebPanel: TWebPanel;
- v: Variant;
- parameters: string;
- OldTag, iLoop: Integer;
- PostFields, Field: TStringList;
- WebURL, FieldName, ALoginName, FieldValue: string;
- WebTabAcount: TWebTabAcount;
- SetTagAsZero: Boolean;
- begin
- WebBrowser := ASender as TWebBrowser;
- OldTag := WebBrowser.Tag;
- SetTagAsZero := True;
- PanelForIE := WebBrowser.Owner as TPanel;
- try
- if (not PanelForIE.Visible) and (not AnsiSameText(URL, 'about:blank')) then
- begin
- //PanelForIE.Visible := True;
- WebBrowser.OnDocumentComplete := nil;
- WebBrowser.Navigate('about:blank');
- //ShellExecute(handle,'open',pchar('C:\Program Files\Internet Explorer\IEXPLORE.EXE'),PChar(String(URL)),'',SW_SHOWMAXIMIZED);
- ShellExecute(handle, 'open', PChar(GetDefaultBrowser), PChar(string(URL)), '', SW_SHOWMAXIMIZED);
- Exit;
- end;
- {if not AnsiSameText(URL, 'about:blank') then
- begin
- WebBrowser.OnDocumentComplete := nil;
- with cbxURLInputer.ItemsEx.Add do
- begin
- Caption := URL;
- if (Copy(Caption, 1, 5) = 'file:') or (Copy(Caption, 2, 1) = ':') then
- ImageIndex := 2
- else if Copy(Caption, 1, 4) = 'ftp:' then
- ImageIndex := 1
- else
- ImageIndex := 0;
- end;
- cbxURLInputer.ItemIndex := cbxURLInputer.ItemsEx.Count - 1;
-
- if WebBrowser.Document <> nil then
- begin
- (WebBrowser.Application as IOleobject).DoVerb(OLEIVERB_UIACTIVATE, nil, WebBrowser, 0, Handle, GetClientRect);
- end;
- end;}
- if AnsiSameText(URL, 'about:blank') and (WebBrowser.Tag >= 0) and (TabAcountIndex >= 0) then
- begin
- WebPanel := FWebPanels.Objects[WebBrowser.Tag] as TWebPanel;
- if WebPanel.Acounts.Count > 0 then
- WebTabAcount := WebPanel.Acounts[TabAcountIndex]
- else
- WebTabAcount := nil;
- WebBrowser.Tag := -1;
- WebURL := WebPanel.URL;
- if WebPanel.FName = '网络存储' then
- begin
- OpenNewWorkDisk(WebPanel.FURL);
- Exit;
- end;
- if WebPanel.FNavigateType = ntGET then
- begin
- if Length(Trim(WebPanel.PostFields)) > 0 then
- begin
- if Pos('?', WebPanel.URL) > 0 then
- WebURL := WebPanel.URL + '&' + ReplaceStr(WebPanel.PostFields, ',', '&')
- else
- WebURL := WebPanel.URL + '?' + ReplaceStr(WebPanel.PostFields, ',', '&');
- end;
- if WebTabAcount <> nil then
- begin
- WebURL := AnsiReplaceText(WebURL, '[%LoginName%]', WebTabAcount.LoginName);
- WebURL := AnsiReplaceText(WebURL, '[%Password%]', WebTabAcount.Password);
- WebURL := AnsiReplaceText(WebURL, '[%BASE64_LoginName%]', StrToBase64(WebTabAcount.LoginName));
- WebURL := AnsiReplaceText(WebURL, '[%BASE64_Password%]', StrToBase64(WebTabAcount.Password));
- WebURL := AnsiReplaceText(WebURL, '[%MD5_LoginName%]', MD5En(WebTabAcount.LoginName));
- WebURL := AnsiReplaceText(WebURL, '[%MD5_Password%]', MD5En(WebTabAcount.Password));
- WebURL := AnsiReplaceText(WebURL, '[%BASE64_MD5_LoginName%]', StrToBase64(MD5En(WebTabAcount.LoginName)));
- WebURL := AnsiReplaceText(WebURL, '[%BASE64_MD5_Password%]', StrToBase64(MD5En(WebTabAcount.Password)));
- end;
- parameters := ALoginName + ' ' + RealICQClient.Password;
- ShellExecute(handle, 'open', PChar(GetDefaultBrowser), PChar(string(Trim(WebURL))), PChar(parameters), SW_SHOWMAXIMIZED);
- end
- else
- begin
- v := VarArrayCreate([0, 0], varVariant);
- v[0] := '<body>' + '<form method="post" action="' + WebURL + '" target="_blank">';
- PostFields := SplitString(WebPanel.PostFields, ',');
- for iLoop := 0 to PostFields.Count - 1 do
- begin
- Field := SplitStringEx(PostFields.Strings[iLoop], '=');
- try
- FieldName := Field.Strings[0];
- FieldValue := Field.Strings[1];
- if WebTabAcount <> nil then
- begin
- FieldValue := AnsiReplaceText(FieldValue, '[%LoginName%]', WebTabAcount.LoginName);
- FieldValue := AnsiReplaceText(FieldValue, '[%Password%]', WebTabAcount.Password);
- FieldValue := AnsiReplaceText(FieldValue, '[%BASE64_LoginName%]', StrToBase64(WebTabAcount.LoginName));
- FieldValue := AnsiReplaceText(FieldValue, '[%BASE64_Password%]', StrToBase64(WebTabAcount.Password));
- FieldValue := AnsiReplaceText(FieldValue, '[%MD5_LoginName%]', MD5En(WebTabAcount.LoginName));
- FieldValue := AnsiReplaceText(FieldValue, '[%MD5_Password%]', MD5En(WebTabAcount.Password));
- FieldValue := AnsiReplaceText(FieldValue, '[%BASE64_MD5_LoginName%]', StrToBase64(MD5En(WebTabAcount.LoginName)));
- FieldValue := AnsiReplaceText(FieldValue, '[%BASE64_MD5_Password%]', StrToBase64(MD5En(WebTabAcount.Password)));
- end;
- v[0] := v[0] + '<input type="hidden" ' + 'name="' + FieldName + '" ' + 'value="' + FieldValue + '">';
- except
- end;
- Field.Free;
- end;
- PostFields.Free;
- v[0] := v[0] + '</form>' + '</body>';
- (WebBrowser.Document as IHtmlDocument2).Write(PSafeArray(TVarData(v).VArray));
- WebBrowser.oleobject.document.Forms.Item(0, 0).Submit;
- end;
- end;
- finally
- ClearMemory;
- if SetTagAsZero then
- WebBrowser.Tag := -1;
- //pgcMainWorkArea.ActivePageIndex := 0;
- end;
- end;
- procedure TMainForm.WebBrowserForPostWorkOrderDocumentComplete(ASender: TObject; const pDisp: IDispatch; var URL: OleVariant);
- begin
- //
- { if URL='about:blank' then
- begin
- v := VarArrayCreate([0, 0], varVariant);
- v[0] := '<body>' +
- '<form method="post" action="' + WebURL + '" target="_blank">';
- v[0] := v[0] +
- '<input type="hidden" ' +
- 'name="' + FieldName +'" ' +
- 'value="'+ FieldValue + '">';
- v[0] := v[0] +
- '</form>' +
- '</body>';
- (WebBrowserForPostWorkOrder.Document as IHtmlDocument2).Write(PSafeArray(TVarData(v).VArray));
- WebBrowserForPostWorkOrder.oleobject.document.Forms.Item(0, 0).Submit;
- end; }
- end;
- procedure TMainForm.UploadWebTabAccounts;
- var
- iLoop, jLoop: Integer;
- WebPanel: TWebPanel;
- StrTemp: string;
- WebTabAcount: TWebTabAcount;
- begin
- StrTemp := '';
- for iLoop := 0 to WebPanels.Count - 1 do
- begin
- WebPanel := WebPanels.Objects[iLoop] as TWebPanel;
- for jLoop := 0 to WebPanel.Acounts.Count - 1 do
- begin
- WebTabAcount := WebPanel.Acounts[jLoop];
- StrTemp := StrTemp + IntToStr(WebTabAcount.WebTabID) + Chr(10) + WebTabAcount.LoginName + Chr(10) + WebTabAcount.Password + Chr(10) + WebTabAcount.Title + Chr(10) + WebTabAcount.Explain + Chr(10) + Chr(13);
- end;
- end;
- MainForm.RealICQClient.CallServerDBProcedure('SetWebTabAcounts', StrTemp);
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.WebTabShow(Sender: TObject);
- var
- iIndex: Integer;
- TabSheet: TTabSheet;
- WebPanel: TWebPanel;
- WebTabAcount: TWebTabAcount;
- iLoop: Integer;
- begin
- if not DisplayWebs then
- Exit;
- TabSheet := Sender as TTabSheet;
- //TabSheet.OnShow := nil;
- iIndex := FWebTabs.IndexOf(TabSheet);
- iIndex := TabSheet.Tag;
- WebPanel := FWebPanels.Objects[iIndex] as TWebPanel;
- TabAcountIndex := 0;
- if WebPanel.Acounts.Count = 0 then
- begin
- if not ((Pos('[%', WebPanel.URL) <= 0) and (Pos('%]', WebPanel.URL) <= 0) and (Pos('[%', WebPanel.PostFields) <= 0) and (Pos('%]', WebPanel.PostFields) <= 0)) then
- begin
- AddWebTabForm := TAddWebTabForm.Create(Self);
- try
- AddWebTabForm.NewWebPanel := True;
- AddWebTabForm.Left := Mouse.CursorPos.X;
- AddWebTabForm.Top := Mouse.CursorPos.Y - 20;
- if Left <= AddWebTabForm.Width then
- AddWebTabForm.Left := Left + Width - 10
- else
- AddWebTabForm.Left := Left - AddWebTabForm.Width + 10;
- if (AddWebTabForm.Top + AddWebTabForm.Height) > Screen.Height then
- AddWebTabForm.Top := Screen.Height - AddWebTabForm.Height;
- if AddWebTabForm.ShowModal = mrOK then
- begin
- WebTabAcount := TWebTabAcount.Create;
- WebTabAcount.WebTabID := StrToInt(WebPanel.ID);
- WebTabAcount.Title := Trim(AddWebTabForm.edTitle.Text);
- WebTabAcount.LoginName := AddWebTabForm.ALoginName;
- WebTabAcount.Password := AddWebTabForm.APassword;
- WebTabAcount.Explain := Trim(AddWebTabForm.edExplain.Text);
- WebPanel.Acounts.Add(WebTabAcount);
- UploadWebTabAccounts;
- end
- else
- begin
- TabAcountIndex := -1;
- end;
- finally
- FreeAndNil(AddWebTabForm);
- end;
- end;
- end;
- OpenWebTab(TabSheet, WebPanel, TabAcountIndex);
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.ShowOrHideMuiltiWeb;
- var
- OldWidth: Integer;
- begin
- LockWindowUpdate(GetDesktopWindow);
- OldWidth := pnlMiddleClient.Width;
- try
- //if not pnlMiddleRight.Visible then pnlMiddleRight.Width := 680;
- pnlMiddleRight.Visible := not pnlMiddleRight.Visible;
- Spl.Visible := pnlMiddleRight.Visible;
- if not pnlMiddleRight.Visible then
- begin
- Width := Width - pnlMiddleRight.Width - Spl.Width;
- Spl.Align := alRight;
- pnlMiddleClient.Align := alClient;
- pnlMiddleRight.Align := alRight;
- pnlAll.Constraints.MinWidth := pnlMiddleClient.Constraints.MinWidth;
- pnlAll.Constraints.MaxWidth := pnlMiddleClient.Constraints.MaxWidth;
- end
- else
- begin
- // Width := Width + pnlMiddleRight.Width + Spl.Width;
- Top := Screen.Height div 2 - 290;
- Left := Screen.Width div 2 - 440;
- Width := 880;
- Height := 580;
- Spl.Align := alLeft;
- pnlMiddleClient.Align := alLeft;
- pnlMiddleRight.Align := alClient;
- pnlAll.Constraints.MinWidth := pnlMiddleClient.Constraints.MinWidth + pnlMiddleRight.Constraints.MinWidth + Spl.Width;
- pnlAll.Constraints.MaxWidth := 0;
- pnlMiddleClient.Left := 0;
- spl.Left := pnlMiddleClient.Left + pnlMiddleClient.Width + 1;
- end;
- finally
- pnlMiddleClient.Width := OldWidth;
- LockWindowUpdate(0);
- end;
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.actMsgManagerExecute(Sender: TObject);
- begin
- if MessagesManagerForm <> nil then
- begin
- MessagesManagerForm.BringToFront;
- Exit;
- end;
- MessagesManagerForm := TMessagesManagerForm.Create(Application);
- MessagesManagerForm.Width := Round(Screen.WorkAreaWidth * 0.70);
- MessagesManagerForm.Height := Round(Screen.WorkAreaHeight * 0.70);
- MessagesManagerForm.Show;
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.RealICQClientAddedBlacklists(Sender: TObject; ALoginName: string);
- var
- ItemIndex: Integer;
- RealICQUser: TRealICQUser;
- RealICQContacterListView: TRealICQContacterListView;
- RealICQContacterListItem: TRealICQContacterListItem;
- begin
- RealICQContacterListView := GetListViewByLoginName(ALoginName);
- if RealICQContacterListView.Items.IndexOf(ALoginName) = -1 then
- begin
- ItemIndex := RealICQClient.Blacklists.IndexOf(ALoginName);
- RealICQUser := RealICQClient.Blacklists.Objects[ItemIndex] as TRealICQUser;
- RealICQContacterListView := GetListViewByLoginName(RealICQUser.LoginName);
- ItemIndex := RealICQContacterListView.Items.IndexOf(RealICQUser.LoginName);
- RealICQContacterListItem := RealICQContacterListView.Items.Objects[ItemIndex] as TRealICQContacterListItem;
- //BindUserDataToItem(RealICQContacterListItem, RealICQUser);
- TUsersService.GetUsersService.UpdateListItem(RealICQContacterListView, RealICQContacterListItem, RealICQUser);
- end;
- end;
- procedure TMainForm.RealICQClientAddFriendRequest(Sender: TObject; ALoginName, ATag: string);
- begin
- AddMessageHistory(smSimple, ALoginName + ' 请求加您为好友', nil);
- ShowAddFriendRequestWindow(Self, ALoginName, ATag);
- end;
- procedure TMainForm.RealICQClientAddFriendResponse(Sender: TObject; ALoginName, ATag: string; AAcceptted: Boolean);
- var
- RealICQUser: TRealICQUser;
- itemIndex: Integer;
- begin
- if AAcceptted then
- begin
- RealICQUser := TUsersService.GetUsersService.GetOrRequestUser(ALoginName);
- AddMessageHistory(smSimple, '您已将 ' + ALoginName + ' 添加至好友列表', nil);
- FNotAddedEmployeeList.AddObject(RealICQUser.LoginName, RealICQUser);
-
- //显示好友
- // ShowGroupInterface;
- ShowNotifyAlertForm('已将 ' + ALoginName + ' 添加至好友列表');
- end
- else
- begin
- if Length(ATag) = 0 then
- ATag := '无';
- AddMessageHistory(smSimple, ALoginName + ' 拒绝了您添加好友的请求', nil);
- ShowNotifyAlertForm(ALoginName + ' 拒绝添加好友的请求' + #$D#$A + '附言：' + ATag);
- end;
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.actOpenMainFormExecute(Sender: TObject);
- begin
- if FHidden then
-
ZoomEffect(Self, zaMaximize);
-
Show;
- ShowWindow(Handle, SW_SHOW);
- ForceForeGroundWindow(Handle);
- FHidden := False;
- if FMainFormHidden then
- begin
- //FDblClickedTrayIcon := True;
- //TimerForShowMainForm.Enabled := False;
- //TimerForShowMainForm.Enabled := True;
-
SetForegroundWindow(TrueHiddenMainForm.Handle);
- ShowMainForm;
- end
- else
- HideMainForm;
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.actOpenRecvFileDirExecute(Sender: TObject);
- begin
- ShellExecute(handle, 'open', PChar('"' + RecvFileDir + '"'), '', '', SW_SHOWNORMAL);
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.actOptionsExecute(Sender: TObject);
- begin
- if OptionsForm <> nil then
- Exit;
- OptionsForm := TOptionsForm.Create(Self);
- try
- OptionsForm.ShowModal;
- finally
- FreeAndNil(OptionsForm);
- end;
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.actPersonalSetExecute(Sender: TObject);
- var
- AForm: IUIForm;
- begin
- if OptionsForm <> nil then
- Exit;
- OptionsForm := TOptionsForm.Create(Self);
- try
- OptionsForm.PageIndex := 0;
- OptionsForm.ShowModal;
- finally
- FreeAndNil(OptionsForm);
- end;
- end;
- procedure TMainForm.actQuitExecute(Sender: TObject);
- var
- iWaitTimes: Integer;
- begin
- if RealICQClient.Connected then
- begin
- if GetTalkingFormCount > 0 then
- begin
- if MessageBox(Handle, '确实要退出吗，此操作将会关闭所有的对话窗口！', '提示', MB_ICONINFORMATION or MB_OKCANCEL) = ID_CANCEL then
- Exit;
- if Showing then
- Close;
- CloseAllTalkingForm;
- iWaitTimes := 0;
- while GetTalkingFormCount > 0 do
- begin
- Sleep(100);
- Inc(iWaitTimes);
- if iWaitTimes > 100 then
- Break;
- Application.ProcessMessages;
- end;
- end;
- RealICQClient.Logout;
- TTeamsAdapter.Stop;
- end;
- if Showing then
- Close;
- MainForm.OnClose := nil;
- MainForm.Close;
- TrueHiddenMainForm.Close;
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.actConnectSetExecute(Sender: TObject);
- begin
- if OptionsForm <> nil then
- Exit;
- OptionsForm := TOptionsForm.Create(Self);
- try
- OptionsForm.LVOptions.Enabled := False;
- OptionsForm.PageIndex := 6;
- OptionsForm.ShowModal;
- //OptionsForm.Show;
- finally
- FreeAndNil(OptionsForm);
- end;
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.actCreateTeamExecute(Sender: TObject);
- //var
- // iLoop: Integer;
- // Team: TRealICQTeam;
-
begin
- // for iLoop := 0 to RealICQClient.Teams.Count - 1 do
- // begin
- // Team := RealICQClient.Teams.Objects[iLoop] as TRealICQTeam;
- // if (not Team.IsTempTeam) and AnsiSameText(Team.TeamCreater, RealICQClient.LoginName) then
- // begin
- // MessageBox(Handle, '抱歉，您已经创建了一个群组了！', '提示', MB_ICONINFORMATION);
- // Exit;
- // end;
- // end;
- //if CreateTeamForm = nil then CreateTeamForm := TCreateTeamForm.Create(Self);
- //CreateTeamForm.Show;
-
try
- //非办公助手企业用户无新建群组权限
- if (FProductType <> ptBGZS) AND ((FUserType = utUnknown) OR (FUserType = utCompany)) then
- begin
- ShowMessage('您没有创建群组权限! ');
- Exit;
- end;
- CreateTeamForm := TCreateTeamForm.Create(Self);
- try
- CreateTeamForm.ShowModal;
- finally
- FreeAndNil(CreateTeamForm);
- end;
- except
- end;
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.actCustomFacesManagerExecute(Sender: TObject);
- begin
- if CustomFacesManagerForm = nil then
- CustomFacesManagerForm := TCustomFacesManagerForm.Create(Application);
- CustomFacesManagerForm.Show;
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.actAVSetExecute(Sender: TObject);
- begin
- WinExec(PChar('"' + ExtractFilePath(Application.ExeName) + AVSetExeFile + '" "' + ExtractFilePath(Application.ExeName) + 'Languages\' + MainForm.Language + '.ini' + '"'), SW_SHOWNORMAL);
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.actChangePassExecute(Sender: TObject);
- begin
- if ChangePassForm <> nil then
- Exit;
- ChangePassForm := TChangePassForm.Create(Self);
- try
- ChangePassForm.ShowModal;
- finally
- FreeAndNil(ChangePassForm);
- end;
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.actCloseExecute(Sender: TObject);
- begin
- Close;
- end;
- //--------------------------------------------------------------
- procedure ClearFileMissions;
- var
- iLoop, jLoop: Integer;
- UploadMission: TUploadMission;
- DownloadMission: TDownloadMission;
- Missions: TStringList;
- begin
- for iLoop := FUploadMissions.Count - 1 downto 0 do
- begin
- UploadMission := FUploadMissions.Objects[iLoop] as TUploadMission;
- try
- FreeAndNil(UploadMission);
- except
- end;
- end;
- FUploadMissions.Clear;
- for iLoop := FSavedUploadMissions.Count - 1 downto 0 do
- begin
- Missions := TStringList(FSavedUploadMissions[iLoop]);
- for jLoop := Missions.Count - 1 downto 0 do
- begin
- UploadMission := Missions.Objects[jLoop] as TUploadMission;
- try
- FreeAndNil(UploadMission);
- except
- end;
- end;
- Missions.Clear;
- FreeAndNil(Missions);
- end;
- FSavedUploadMissions.Clear;
- for iLoop := FSavedDownloadMissions.Count - 1 downto 0 do
- begin
- Missions := TStringList(FSavedDownloadMissions[iLoop]);
- for jLoop := Missions.Count - 1 downto 0 do
- begin
- DownloadMission := Missions.Objects[jLoop] as TDownloadMission;
- try
- FreeAndNil(DownloadMission);
- except
- end;
- end;
- Missions.Clear;
- FreeAndNil(Missions);
- end;
- FSavedDownloadMissions.Clear;
- for iLoop := FDownloadMissions.Count - 1 downto 0 do
- begin
- DownloadMission := FDownloadMissions.Objects[iLoop] as TDownloadMission;
- try
- FreeAndNil(DownloadMission);
- except
- end;
- end;
- FDownloadMissions.Clear;
- end;
- //---退出主程序-----------------------------------------------------
- procedure TMainForm.QuitWindows;
- var
- iWaitTimes: Integer;
- begin
- RealICQClient.OnLoginFailed := nil;
- if RealICQClient.Connected then
- begin
- if GetTalkingFormCount > 0 then
- begin
- if Showing then
- Close;
- CloseAllTalkingForm;
- iWaitTimes := 0;
- while GetTalkingFormCount > 0 do
- begin
- Sleep(100);
- Inc(iWaitTimes);
- if iWaitTimes > 100 then
- Break;
- Application.ProcessMessages;
- end;
- end;
- RealICQClient.Logout;
- end;
- if Showing then
- Close;
- MainForm.OnClose := nil;
- MainForm.Close;
- TrueHiddenMainForm.Close;
- end;
- //-----获的天气信息--------------------------------------------------------
- procedure TMainForm.GetWeather(City, Weatheren, Weather: string);
- var
- Data: CopyDataStruct;
- Args: PChar;
- weatherImgPath: string;
- WeatherList: TStringList;
- WeatherPanelWidth: Integer;
- begin
- lblWeatherCity.Caption := City;
- lblWeatheren.Caption := Weatheren;
- lblWeather.Caption := Weather;
- weatherImgPath := ExtractFilePath(paramstr(0)) + 'Images\Weather\' + GetWeatherImgName(lblWeather.Caption);
- if fileexists(weatherImgPath) then
- imgWeather.Picture.LoadFromFile(weatherImgPath);
- WeatherPanelWidth := lblWeatherCity.Left + lblWeatherCity.Width + 5 + imgWeather.Width + 5 + lblWeather.Width + 5 + lblWeatheren.Width;
- if pnlWebSearch.Width - spbAddFriend.Left >= WeatherPanelWidth then
- lblWeatherCity.Left := spbAddFriend.Left
- else
- lblWeatherCity.Left := btMainMenu.Left + btMainMenu.Width + 5;
- imgWeather.Left := lblWeatherCity.Left + lblWeatherCity.Width + 5;
- lblWeather.Left := imgWeather.Left + imgWeather.Width + 5;
- lblWeatheren.Left := lblWeather.Left + lblWeather.Width + 5;
- end;
- procedure TMainForm.SetGetMoreUserEvent;
- begin
- RealICQClient.OnGettedMoreBranchList := RealICQClientGettedMoreBranchList;
- RealICQClient.OnGettedMoreUserList := RealICQClientGettedMoreUserList;
- if (MessageBoxForm <> nil) then
- begin
- FreeAndNil(MessageBoxForm);
- MessageBoxForm := nil;
- end;
- end;
- //------------------------------------------------------------------------------
- procedure TMainForm.OpenWebTab(TabSheet: TTabSheet; WebPanel: TWebPanel; AcountIndex: Integer);
- var
- Panel, PanelForIE: TPanel;
- WebBrowser: TWebBrowser;
- begin
- TabAcountIndex := AcountIndex;
- Panel := TPanel.Create(TabSheet);
- Panel.Parent := TabSheet;
- Panel.DoubleBuffered := True;
- Panel.Font.Color := spbDisplayName.Font.Color;
- Panel.Caption := '页面加载中...';
- Panel.Color := clWhite;
- Panel.Align := alClient;
- Panel.BevelInner := bvNone;
- Panel.BevelOuter := bvNone;
- Panel.Visible := True;
- Application.ProcessMessages;
- PanelForIE := TPanel.Create(Panel);
- PanelForIE.Parent := Panel;
- PanelForIE.Tag := TabSheet.Tag;
- PanelForIE.DoubleBuffered := True;
- PanelForIE.Color := clWhite;
- PanelForIE.Align := alClient;
- PanelForIE.BevelInner := bvNone;
- PanelForIE.BevelOuter := bvNone;
- PanelForIE.Visible := True;
- Application.ProcessMessages;
- WebBrowser := TWebBrowser.Create(PanelForIE);
- WebBrowser.DoubleBuffered := True;
- WebBrowser.ParentWindow := PanelForIE.Handle;
- WebBrowser.Align := alClient;
- WebBrowser.Visible := True;
- WebBrowser.Tag := TabSheet.Tag;
- WebBrowser.RegisterAsBrowser := True;
- WebBrowser.RegisterAsDropTarget := True;
- //WebBrowser.OnBeforeNavigate2 := WebBrowserRightBeforeNavigate2;
- if WebPanel.FNavigateType = ntFill then
- WebBrowser.OnDocumentComplete := WebBrowserRightDocumentCompleteForPost
- else
- WebBrowser.OnDocumentComplete := WebBrowserRightDocumentComplete;
- PanelForIE.InsertControl(WebBrowser);
- Application.ProcessMessages;
- if DisplayWebs then
- begin
- if WebPanel.FNavigateType = ntFill then
- WebBrowser.Navigate(WebPanel.FURL)
- else
- WebBrowser.Navigate('about:blank');
- end;
- end;
- //-------------------------------------------------------
-
procedure TMainForm.LoadMainTabImage;
- begin
- MyContactersIcon.Picture.Bitmap.LoadFromFile(ExtractFilePath(Application.ExeName) + MainTabImageDir + '1.bmp');
- SysMsgIcon.Picture.Bitmap.LoadFromFile(ExtractFilePath(Application.ExeName) + MainTabImageDir + '2.bmp');
- MyFriendIcon.Picture.Bitmap.LoadFromFile(ExtractFilePath(Application.ExeName) + MainTabImageDir + '3.bmp');
- MyTeamIcon.Picture.Bitmap.LoadFromFile(ExtractFilePath(Application.ExeName) + MainTabImageDir + '4.bmp');
- LatestsIcon.Picture.Bitmap.LoadFromFile(ExtractFilePath(Application.ExeName) + MainTabImageDir + '5.bmp');
- end;
- //------------------------------------------------------------------------------
- //下载升级配置文件
- //------------------------------------------------------------------------------
- procedure TMainForm.DownLoadUpdateConfig;
- var
- TempDir: string;
- begin
- TempDir := GetMyDocument + '\Update';
- if not DirectoryExists(TempDir) then
- ForceDirectories(TempDir);
- if FileExists(GetMyDocument + '\Update\Update.dat') then
- begin
- SetFileAttributes(pchar(GetMyDocument + '\Update\Update.dat'), file_attribute_normal);
- DeleteFile(GetMyDocument + '\Update\Update.dat');
- end;
- //FDownFile.ThreadDownFile('http://' + MainForm.RealICQClient.RemoteAddress + '/Update/Update.dat', TempDir + '\Update.dat');
- end;
- //------------------------------------------------------------------------------
- //文件下载完成事件处理函数
- //-----------------------------------------------------------------------------=
- procedure TMainForm.DownFaceFileComplete(Source_file, Dest_file: string; blStatus: boolean; ErrMessage: string);
- begin
- ShowGettedFace(Dest_file);
- end;
- procedure TMainForm.DownFileComplete(Source_file, Dest_file: string; blStatus: boolean; ErrMessage: string);
- var
- OldVersion, Version: string;
- F: Textfile;
- City, Weatheren, Weather: string;
- function GetVersionFromIniFile(FileName: string): string;
- var
- IniFile: TIniFile;
- begin
- IniFile := TIniFile.Create(ExtractFilePath(paramstr(0)) + 'Update.dat');
- try
- OldVersion := IniFile.ReadString('Version', 'Version', '1.0.0.0');
- finally
- IniFile.Free;
- end;
- end;
- begin
- if FileExists(Dest_file) then
- begin
- if UpperCase(ExtractFileExt(Dest_file)) = '.DAT' then
- begin
- OldVersion := '1.0.0.0';
- if FileExists(ExtractFilePath(paramstr(0)) + 'Update.dat') then
- OldVersion := GetVersionFromIniFile(ExtractFilePath(paramstr(0)) + 'Update.dat');
- if FileExists(GetMyDocument + '\Update\Update.dat') then
- Version := GetVersionFromIniFile(GetMyDocument + '\Update\Update.dat');
- if trim(OldVersion) <> trim(Version) then
- WinExec('Update.exe', SW_SHOW);
- end
- else
- begin
- AssignFile(F, Dest_file);
- try
- Reset(F);
- Readln(F, City);
- Readln(F, Weatheren);
- Readln(F, Weather);
- GetWeather(City, Weatheren, Weather);
- finally
- Closefile(F); {关闭文件 F}
- end;
- end;
- end;
- end;
- //------------------------------------------------------------------------------
- //
- //------------------------------------------------------------------------------
- procedure TMainForm.RealICQClientGettedSysMsgInterfaces(Sender: TObject);
- begin
- //
- end;
- //------------------------------------------------------------------------------
- function TMainForm.GetBranchName(LoginName: string): string;
- var
- ItemIndex: Integer;
- Branch: TRealICQBranch;
- Employee: TRealICQEmployee;
- Node: TTreeNode;
- RealICQContacterTreeView: TRealICQContacterTreeView;
- begin
- Result := '';
- if MainForm.GetActiveTabSheetName = LVMoreUsers then
- begin
- ItemIndex := MainForm.ContacterTreeViews.IndexOf(LVMoreUsers);
- RealICQContacterTreeView := MainForm.ContacterTreeViews.Objects[ItemIndex] as TRealICQContacterTreeView;
- end
- else
- begin
- ItemIndex := MainForm.ContacterTreeViews.IndexOf(LVMyContacters);
- RealICQContacterTreeView := MainForm.ContacterTreeViews.Objects[ItemIndex] as TRealICQContacterTreeView;
- end;
- Employee := RealICQContacterTreeView.GetEmployee(LoginName);
- if (Employee = nil) then
- Exit;
- Node := Employee.Node.Parent;
- Result := Node.Text;
- while Node.Parent <> nil do
- begin
- Node := Node.Parent;
- if Node = nil then
- Break;
- if Node.Parent <> nil then
- Result := Node.Text + '/' + Result;
- end;
- end;
- //------------------------------------------------------------------------------
- function TMainForm.GetCompany: string;
- var
- iIndex: Integer;
- ServerInfo: TServerInfo;
- begin
- Result := '';
- if (FServerInfoList.IndexOf(MainForm.CurrentServerID) < 0) or (FServerInfoList.IndexOf(MainForm.RealICQClient.ServerID) < 0) then
- Exit;
- if MainForm.GetActiveTabSheetName = LVMoreUsers then
- ServerInfo := FServerInfoList.Objects[FServerInfoList.IndexOf(MainForm.CurrentServerID)] as (TServerInfo)
- else
- ServerInfo := FServerInfoList.Objects[FServerInfoList.IndexOf(MainForm.RealICQClient.ServerID)] as (TServerInfo);
- if Assigned(ServerInfo) then
- Result := ServerInfo.ServerName;
- end;
- //------------------------------------------------------------------------------
- //用post方式提交XML文件到服务器
- //------------------------------------------------------------------------------
-
{
-
procedure TMainForm.PostUpdateLog;
- function ReadUpdateLog: string;
- var
- XMLFile: string;
- ConfigNode: IXMLNode;
- XMLDocument: TXMLDocument;
- begin
- Result := '';
- XMLFile := ExtractFilePath(paramstr(0)) + ConfigXMLFilePath + UpdateLogXMLFile;
- XMLDocument := TXMLDocument.Create(Self);
- try
- try
- if FileExists(XMLFile) then
- begin
- XMLDocument.Active := True;
- XMLDocument.LoadFromFile(XMLFile);
- ConfigNode := XMLDocument.DocumentElement;
- if ConfigNode.ChildNodes.FindNode('product').Attributes['status'] then
- begin
- Result := XMLDocument.XML.Text;
- end;
- end;
- except
- on E: EXception do
- end;
- finally
- XMLDocument.Free;
- end;
- end;
- var
- XMLStr, Url: string;
- begin
- Url := GetUpdateLogPostUrl(ExtractFilePath(paramstr(0)) + 'Online.ini');
- if Url = '' then
- Url := DefaultUpdateLogPostUrl;
- Url := Url + '?LoginName=' + RealICQClient.LoginName + '&DisplayName=' + HttpEncode(AnsiToUtf8(RealICQClient.Me.DisplayName)) + '&ServerName=' + HttpEncode(AnsiToUtf8(edServerList.Text));
- XMLStr := ReadUpdateLog;
- if XMLStr <> '' then
- begin
- TThreadPost.Create(Url, XMLStr);
- end;
- end;
- }
- //------------------------------------------------------------------------------
- procedure TMainForm.UpdatePostLogState(Status: Boolean);
- var
- XMLFile: string;
- ConfigNode: IXMLNode;
- XMLDocument: TXMLDocument;
- begin
- XMLFile := ExtractFilePath(paramstr(0)) + ConfigXMLFilePath + UpdateLogXMLFile;
- XMLDocument := TXMLDocument.Create(Self);
- try
- try
- if FileExists(XMLFile) then
- begin
- XMLDocument.Active := True;
- XMLDocument.LoadFromFile(XMLFile);
- ConfigNode := XMLDocument.DocumentElement;
- ConfigNode.ChildNodes.FindNode('product').Attributes['status'] := Status;
- XMLDocument.SaveToFile(XMLFile);
- end;
- except
- end;
- finally
- XMLDocument.Free;
- end;
- end;
- constructor TThreadPost.Create(URL, Content: string);
- begin
- inherited Create(True);
- FURL := URL;
- FContent := Content;
- FreeOnTerminate := True;
- Resume;
- end;
- procedure TThreadPost.Execute;
- var
- IdHttp: TIdHTTP;
- Sends: TStrings;
- begin
- IdHttp := TIdHTTP.Create(nil);
- Sends := TStringList.Create;
- try
- IdHttp.Request.ContentType := 'application/x-www-form-urlencoded';
- Sends.Add('XmlStr=' + StrToBase64(FContent));
- IdHttp.Post(FUrl, Sends);
- MainForm.UpdatePostLogState(False);
- finally
- FreeAndNil(IdHttp);
- Sends.Free;
- end;
- end;
- //---------------检测指定的进程是否运行-----------------------------------------
- constructor TCheckRunProcessThread.Create(AProgramName, AProcessPath: string);
- begin
- inherited Create(True);
- ProgramName := AProgramName;
- ProcessPath := AProcessPath;
- FreeOnTerminate := True;
- Resume;
- end;
- //------------得到进程的执行路径------------------------------------------------
- function TCheckRunProcessThread.GetProcessPath(ProcessID: DWORD): string;
- var
- Hand: THandle;
- ModName: array[0..Max_Path - 1] of Char;
- hMod: HModule;
- n: DWORD;
- begin
- Result := '';
- Hand := OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_READ, False, ProcessID);
- if Hand > 0 then
- try
- ENumProcessModules(Hand, @hMod, Sizeof(hMod), n);
- if GetModuleFileNameEx(Hand, hMod, ModName, Sizeof(ModName)) > 0 then
- Result := ModName; //得到路径和文见名
- except
- end;
- end;
- //根据可执行文件名称查找进程列表，以判断程序是否正在运行。
- function TCheckRunProcessThread.FindProcess(AFileName: string): boolean;
- var
- hSnapshot: THandle; //用于获得进程列表
- lppe: TProcessEntry32; //用于查找进程
- Found: Boolean; //用于判断进程遍历是否完成
- ProcessPath: string;
- begin
- Result := False;
- hSnapshot := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0); //获得系统进程列表
- lppe.dwSize := SizeOf(TProcessEntry32); //在调用Process32First API之前，需要初始化lppe记录的大小
- Found := Process32First(hSnapshot, lppe); //将进程列表的第一个进程信息读入ppe记录中
- while Found do
- begin
- ProcessPath := GetProcessPath(lppe.th32ProcessID);
- if UpperCase(ProcessPath) = UpperCase(AFileName) then
- begin
- Result := True;
- end;
- Found := Process32Next(hSnapshot, lppe); //将进程列表的下一个进程信息读入lppe记录中
- end;
- end;
- //------------------------------------------------------------------------------
- procedure TCheckRunProcessThread.Execute;
- begin
- while FindProcess(ProcessPath) do
- begin
- Sleep(1000);
- end;
- //MainForm.PostUpdateLog;
- end;
- procedure TMainForm.btOAClick(Sender: TObject);
- begin
- MessageBox(Handle, '协同办公系统暂未接入！ ', '提示', MB_ICONINFORMATION);
- end;
- procedure TMainForm.btSwapClick(Sender: TObject);
- begin
- MessageBox(Handle, '公文交换系统暂未接入！ ', '提示', MB_ICONINFORMATION);
- end;
- initialization
- HookID := 0;
- FUploadMissions := TStringList.Create;
- FSavedUploadMissions := TList.Create;
- FDownloadMissions := TStringList.Create;
- FSavedDownloadMissions := TList.Create;
- CoInitialize(nil);
- OleInitialize(nil);
- finalization
- try
- ClearFileMissions;
- FreeAndNil(FSavedDownloadMissions);
- FreeAndNil(FSavedUploadMissions);
- FreeAndNil(FUploadMissions);
- FreeAndNil(FDownloadMissions);
- OleUninitialize;
- CoUninitialize;
- except
- end;
- end.
|
