| 12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967196819691970197119721973197419751976197719781979198019811982198319841985198619871988198919901991199219931994199519961997199819992000200120022003200420052006200720082009201020112012201320142015201620172018201920202021202220232024202520262027202820292030203120322033203420352036203720382039204020412042204320442045204620472048204920502051205220532054205520562057205820592060206120622063206420652066206720682069207020712072207320742075207620772078207920802081208220832084208520862087208820892090209120922093209420952096209720982099210021012102210321042105210621072108210921102111211221132114211521162117211821192120212121222123212421252126212721282129213021312132213321342135213621372138213921402141214221432144214521462147214821492150215121522153215421552156215721582159216021612162216321642165216621672168216921702171217221732174217521762177217821792180218121822183218421852186218721882189219021912192219321942195219621972198219922002201220222032204220522062207220822092210221122122213221422152216221722182219222022212222222322242225222622272228222922302231223222332234223522362237223822392240224122422243224422452246224722482249225022512252225322542255225622572258225922602261226222632264226522662267226822692270227122722273227422752276227722782279228022812282228322842285228622872288228922902291229222932294229522962297229822992300230123022303230423052306230723082309231023112312231323142315231623172318231923202321232223232324232523262327232823292330233123322333233423352336233723382339234023412342234323442345234623472348234923502351235223532354235523562357235823592360236123622363236423652366236723682369237023712372237323742375237623772378237923802381238223832384238523862387238823892390239123922393239423952396239723982399240024012402240324042405240624072408240924102411241224132414241524162417241824192420242124222423242424252426242724282429243024312432243324342435243624372438243924402441244224432444244524462447244824492450245124522453245424552456245724582459246024612462246324642465246624672468246924702471247224732474247524762477247824792480248124822483248424852486248724882489249024912492249324942495249624972498249925002501250225032504250525062507250825092510251125122513251425152516251725182519252025212522252325242525252625272528252925302531253225332534253525362537253825392540254125422543254425452546254725482549255025512552255325542555255625572558255925602561256225632564256525662567256825692570257125722573257425752576257725782579258025812582258325842585258625872588258925902591259225932594259525962597259825992600260126022603260426052606260726082609261026112612 |
- Imports System.Globalization
- Imports System.Net.Sockets
- Imports System.Runtime.CompilerServices
- Imports System.Security.Cryptography
- Imports System.Security.Principal
- Imports System.Text.RegularExpressions
- Imports System.Threading.Tasks
- Imports System.Xaml
- Imports Newtonsoft.Json
- Public Module ModBase
- #Region "声明"
- '下列版本信息由更新器自动修改
- Public Const VersionBaseName As String = "2.12.7.1" '显示用版本名
- Public Const CommitHash As String = "" 'Commit Hash,由 GitHub Workflow 自动替换
- #If RELEASE Then
- Public Const VersionCode As Integer = 394 '正式版
- #Else
- Public Const VersionCode As Integer = 393 '快照版
- #End If
- '版本信息
- Public Const VersionDisplay As String = BuildTypeDisplay & " " & VersionBaseName
- #If DEBUG Then
- Public Const BuildTypeDisplay As String = "开发版"
- Public Const BuildType As BuildTypes = BuildTypes.Debug
- #ElseIf RELEASE Then
- Public Const BuildTypeDisplay As String = "正式版"
- Public Const BuildType As BuildTypes = BuildTypes.Release
- #Else
- Public Const BuildTypeDisplay As String = "快照版"
- Public Const BuildType As BuildTypes = BuildTypes.Snapshot
- #End If
- Public Enum BuildTypes
- Debug = 100
- Release = 50
- Snapshot = 0
- End Enum
- ''' <summary>
- ''' 主窗口句柄。
- ''' </summary>
- Public Handle As IntPtr
- ''' <summary>
- ''' 程序的启动路径,以 \ 结尾。
- ''' </summary>
- Public PathExeFolder As String = AppDomain.CurrentDomain.SetupInformation.ApplicationBase
- ''' <summary>
- ''' 包含程序名的完整路径。
- ''' </summary>
- Public PathExe As String = PathExeFolder & AppDomain.CurrentDomain.SetupInformation.ApplicationName
- ''' <summary>
- ''' 程序内嵌图片文件夹路径,以 / 结尾。
- ''' </summary>
- Public PathImage As String = "pack://application:,,,/Plain Craft Launcher 2;component/Images/"
- ''' <summary>
- ''' 程序的缓存文件夹路径,以 \ 结尾。
- ''' </summary>
- Public PathTemp As String = If(Settings.Get("SystemSystemCache") = "", Path.GetTempPath() & "PCL\", Settings.Get("SystemSystemCache")).ToString.Replace("/", "\").TrimEnd("\") & "\"
- ''' <summary>
- ''' AppData 中的 PCL 文件夹路径,以 \ 结尾。
- ''' </summary>
- Public PathAppdata As String = Environment.GetFolderPath(Environment.SpecialFolder.ApplicationData) & "\PCL\"
- ''' <summary>
- ''' 当前程序的语言。
- ''' </summary>
- Public Lang As String = "zh_CN"
- ''' <summary>
- ''' 程序的打开计时。
- ''' </summary>
- Public ApplicationStartTick As Long = GetTimeMs()
- ''' <summary>
- ''' 程序打开时的时间。
- ''' </summary>
- Public ApplicationOpenTime As Date = Date.Now
- ''' <summary>
- ''' 识别码。
- ''' </summary>
- Public Identify As String = GetIdentify()
- ''' <summary>
- ''' 程序是否已结束。
- ''' </summary>
- Public IsProgramEnded As Boolean = False
- ''' <summary>
- ''' 是否为 32 位系统。
- ''' </summary>
- Public Is32BitSystem As Boolean = Not Environment.Is64BitOperatingSystem
- ''' <summary>
- ''' 是否使用 GBK 编码。
- ''' </summary>
- Public IsGBKEncoding As Boolean = Encoding.Default.CodePage = 936
- ''' <summary>
- ''' 系统盘盘符,以 \ 结尾。例如 “C:\”。
- ''' </summary>
- Public OsDrive As String = Environment.GetLogicalDrives().Where(Function(p) Directory.Exists(p)).First.Upper.First & ":\" '#3799
- #End Region
- #Region "矢量图标"
- Public Class Logo
- ''' <summary>
- ''' 图标按钮,心(空心),1.1x
- ''' </summary>
- Public Const IconButtonLikeLine As String = "M512 896a42.666667 42.666667 0 0 1-30.293333-12.373333l-331.52-331.946667a224.426667 224.426667 0 0 1 0-315.733333 223.573333 223.573333 0 0 1 315.733333 0L512 282.026667l46.08-46.08a223.573333 223.573333 0 0 1 315.733333 0 224.426667 224.426667 0 0 1 0 315.733333l-331.52 331.946667A42.666667 42.666667 0 0 1 512 896zM308.053333 256a136.533333 136.533333 0 0 0-97.28 40.106667 138.24 138.24 0 0 0 0 194.986666L512 792.746667l301.226667-301.653334a138.24 138.24 0 0 0 0-194.986666 141.653333 141.653333 0 0 0-194.56 0l-76.373334 76.8a42.666667 42.666667 0 0 1-60.586666 0L405.333333 296.106667A136.533333 136.533333 0 0 0 308.053333 256z"
- ''' <summary>
- ''' 图标按钮,心(实心),1.1x
- ''' </summary>
- Public Const IconButtonLikeFill As String = "M700.856 155.543c-74.769 0-144.295 72.696-190.046 127.26-45.737-54.576-115.247-127.26-190.056-127.26-134.79 0-244.443 105.78-244.443 235.799 0 77.57 39.278 131.988 70.845 175.713C238.908 694.053 469.62 852.094 479.39 858.757c9.41 6.414 20.424 9.629 31.401 9.629 11.006 0 21.998-3.215 31.398-9.63 9.782-6.662 240.514-164.703 332.238-291.701 31.587-43.724 70.874-98.143 70.874-175.713-0.001-130.02-109.656-235.8-244.445-235.8z m0 0"
- ''' <summary>
- ''' 图标按钮,垃圾桶,1.1x
- ''' </summary>
- Public Const IconButtonDelete As String = "M520.192 0C408.43 0 317.44 82.87 313.563 186.734H52.736c-29.038 0-52.663 21.943-52.663 49.079s23.625 49.152 52.663 49.152h58.075v550.473c0 103.35 75.118 187.757 167.717 187.757h472.43c92.599 0 167.716-83.894 167.716-187.757V285.477h52.59c29.038 0 52.59-21.943 52.663-49.08-0.073-27.135-23.625-49.151-52.663-49.151H726.235C723.237 83.017 631.955 0 520.192 0zM404.846 177.957c3.803-50.03 50.176-89.015 107.447-89.015 57.197 0 103.57 38.985 106.788 89.015H404.92zM284.379 933.669c-33.353 0-69.997-39.351-69.997-95.525v-549.01H833.39v549.522c0 56.247-36.645 95.525-69.998 95.525H284.379v-0.512z M357.23 800.695a48.274 48.274 0 0 0 47.616-49.006V471.7a48.274 48.274 0 0 0-47.543-49.08 48.274 48.274 0 0 0-47.69 49.006V751.69c0 27.282 20.846 49.006 47.617 49.006z m166.62 0a48.274 48.274 0 0 0 47.688-49.006V471.7a48.274 48.274 0 0 0-47.689-49.08 48.274 48.274 0 0 0-47.543 49.006V751.69c0 27.282 21.431 49.006 47.543 49.006z m142.92 0a48.274 48.274 0 0 0 47.543-49.006V471.7a48.274 48.274 0 0 0-47.543-49.08 48.274 48.274 0 0 0-47.616 49.006V751.69c0 27.282 20.773 49.006 47.543 49.006z"
- ''' <summary>
- ''' 图标按钮,禁止,1x
- ''' </summary>
- Public Const IconButtonStop As String = "M508 990.4c-261.6 0-474.4-212-474.4-474.4S246.4 41.6 508 41.6s474.4 212 474.4 474.4S769.6 990.4 508 990.4zM508 136.8c-209.6 0-379.2 169.6-379.2 379.2 0 209.6 169.6 379.2 379.2 379.2s379.2-169.6 379.2-379.2C887.2 306.4 717.6 136.8 508 136.8zM697.6 563.2 318.4 563.2c-26.4 0-47.2-21.6-47.2-47.2 0-26.4 21.6-47.2 47.2-47.2l379.2 0c26.4 0 47.2 21.6 47.2 47.2C744.8 542.4 724 563.2 697.6 563.2z"
- ''' <summary>
- ''' 图标按钮,勾选,1x
- ''' </summary>
- Public Const IconButtonCheck As String = "M512 0a512 512 0 1 0 512 512A512 512 0 0 0 512 0z m0 921.6a409.6 409.6 0 1 1 409.6-409.6 409.6 409.6 0 0 1-409.6 409.6z M716.8 339.968l-256 253.44L328.192 460.8A51.2 51.2 0 0 0 256 532.992l168.448 168.96a51.2 51.2 0 0 0 72.704 0l289.28-289.792A51.2 51.2 0 0 0 716.8 339.968z"
- ''' <summary>
- ''' 图标按钮,笔,1x
- ''' </summary>
- Public Const IconButtonEdit As String = "M732.64 64.32C688.576 21.216 613.696 21.216 569.6 64.32L120.128 499.52c-17.6 12.896-26.432 30.144-30.848 51.68L32 870.048c0 25.856 8.8 56 26.432 73.248 17.632 17.216 17.632 48.704 88.64 48.704h13.248l326.08-56c22.016-4.32 39.68-12.928 52.864-30.176l449.472-435.2c22.048-21.536 35.264-47.36 35.264-77.536 0-30.176-13.216-56-35.264-77.568l-256.096-251.2zM139.712 903.776l56-326.912 311.04-295.136 267.104 269.44-310.976 295.168-323.168 57.44zM844.576 467.84l-273.984-260.672 61.856-59.84c8.832-8.512 26.528-8.512 39.776 0l234.24 226.496c4.384 4.288 8.832 12.8 8.832 17.088s-4.416 8.544-8.864 12.8l-61.856 64.128z"
- ''' <summary>
- ''' 图标按钮,齿轮,1.1x
- ''' </summary>
- Public Const IconButtonSetup As String = "M651.946667 1001.813333c-22.186667 0-42.666667-10.24-61.44-27.306666-23.893333-23.893333-49.493333-35.84-75.093334-35.84-29.013333 0-56.32 11.946667-73.386666 30.72v3.413333c-17.066667 17.066667-42.666667 27.306667-66.56 27.306667h-6.826667c-6.826667 0-11.946667-1.706667-15.36-1.706667l-6.826667-1.706667c-64.853333-20.48-121.173333-54.613333-168.96-98.986666-29.013333-23.893333-37.546667-63.146667-25.6-95.573334 8.533333-23.893333 5.12-51.2-10.24-75.093333-15.36-27.306667-34.133333-40.96-59.733333-47.786667h-1.706667l-5.12-1.706666c-35.84-8.533333-61.44-34.133333-66.56-69.973334C1.706667 575.146667 0 537.6 0 512c0-32.426667 3.413333-63.146667 8.533333-93.866667v-6.826666l3.413334-8.533334c10.24-23.893333 23.893333-40.96 44.373333-51.2 5.12-3.413333 11.946667-6.826667 20.48-8.533333 27.306667-8.533333 51.2-25.6 63.146667-44.373333 13.653333-23.893333 17.066667-52.906667 10.24-81.92-11.946667-34.133333 0-71.68 30.72-93.866667 44.373333-37.546667 97.28-68.266667 158.72-93.866667l3.413333-1.706666c44.373333-13.653333 75.093333 3.413333 92.16 20.48 23.893333 23.893333 49.493333 35.84 75.093333 35.84 30.72 0 56.32-10.24 71.68-30.72l3.413334-3.413334c27.306667-27.306667 63.146667-35.84 93.866666-22.186666 63.146667 22.186667 117.76 54.613333 165.546667 97.28 29.013333 23.893333 37.546667 63.146667 25.6 95.573333-8.533333 23.893333-5.12 51.2 10.24 75.093333 15.36 27.306667 34.133333 40.96 59.733333 47.786667h1.706667l5.12 1.706667c35.84 8.533333 61.44 34.133333 66.56 71.68 6.826667 30.72 10.24 63.146667 11.946667 93.866666v3.413334c0 32.426667-3.413333 63.146667-8.533334 93.866666v6.826667l-3.413333 8.533333c-10.24 23.893333-23.893333 40.96-44.373333 51.2-5.12 3.413333-11.946667 6.826667-20.48 8.533334-27.306667 8.533333-51.2 25.6-63.146667 46.08-13.653333 23.893333-17.066667 52.906667-10.24 81.92 11.946667 35.84-1.706667 75.093333-30.72 95.573333-44.373333 35.84-95.573333 66.56-157.013333 92.16-15.36 3.413333-27.306667 3.413333-35.84 3.413333z m3.413333-83.626666z m1.706667 0zM517.12 853.333333c47.786667 0 93.866667 20.48 134.826667 59.733334 1.706667 1.706667 3.413333 1.706667 3.413333 3.413333 52.906667-22.186667 97.28-49.493333 136.533333-80.213333l1.706667-1.706667v-3.413333c-13.653333-52.906667-8.533333-104.106667 17.066667-148.48 23.893333-39.253333 64.853333-69.973333 114.346666-85.333334 1.706667 0 3.413333-1.706667 6.826667-6.826666 5.12-25.6 8.533333-51.2 8.533333-78.506667-1.706667-29.013333-3.413333-56.32-10.24-81.92v-5.12h-1.706666c-51.2-11.946667-90.453333-39.253333-119.466667-87.04-27.306667-44.373333-34.133333-100.693333-17.066667-148.48l-1.706666-1.706667h-3.413334c-39.253333-35.84-85.333333-63.146667-136.533333-80.213333H648.533333s-1.706667 1.706667-3.413333 1.706667c-32.426667 39.253333-80.213333 59.733333-136.533333 59.733333-47.786667 0-93.866667-20.48-134.826667-59.733333l-1.706667-1.706667h-1.706666c-54.613333 22.186667-98.986667 49.493333-136.533334 80.213333l-1.706666 1.706667v3.413333c13.653333 52.906667 8.533333 104.106667-17.066667 148.48-23.893333 39.253333-64.853333 69.973333-114.346667 85.333334-1.706667 0-3.413333 1.706667-6.826666 6.826666-6.826667 25.6-8.533333 51.2-8.533334 78.506667 0 30.72 3.413333 58.026667 6.826667 76.8l1.706667 5.12h1.706666c51.2 11.946667 90.453333 39.253333 119.466667 87.04 27.306667 44.373333 34.133333 100.693333 17.066667 148.48l1.706666 1.706667 1.706667 1.706666c37.546667 35.84 83.626667 63.146667 134.826667 80.213334 1.706667 0 3.413333 0 3.413333 1.706666h1.706667s1.706667 0 5.12-1.706666c34.133333-37.546667 81.92-59.733333 136.533333-59.733334z m-6.826667-146.773333c-110.933333 0-199.68-85.333333-199.68-196.266667 0-109.226667 87.04-196.266667 199.68-196.266666s199.68 85.333333 199.68 196.266666c-1.706667 109.226667-88.746667 196.266667-199.68 196.266667z m0-307.2c-63.146667 0-114.346667 49.493333-114.346666 110.933333 0 63.146667 49.493333 110.933333 114.346666 110.933334 30.72 0 59.733333-11.946667 80.213334-32.426667 20.48-20.48 32.426667-49.493333 32.426666-78.506667 0-63.146667-49.493333-110.933333-112.64-110.933333z"
- ''' <summary>
- ''' 图标按钮,重置,0.9x
- ''' </summary>
- Public Const IconButtonReset As String = "M667.6817627 313.65283203l-45.28564454 55.76660156L858.06933594 391.27124023 787.61950684 165.93066406l-56.01379395 69.01611328A354.47387695 354.47387695 0 0 0 520.89892578 165.93066406C324.87536621 165.93066406 165.93066406 324.43041992 165.93066406 519.91015625c0 195.52917481 158.94470215 353.97949219 354.96826172 353.97949219a355.06713867 355.06713867 0 0 0 331.73217774-227.66418458 50.52612305 50.52612305 0 0 0-29.21813966-65.25878905 50.77331543 50.77331543 0 0 0-65.50598144 29.16870117A253.61938477 253.61938477 0 0 1 520.94836426 772.78796387c-140.05920411 0-253.61938477-113.21411133-253.61938477-252.87780762 0-139.61425781 113.56018067-252.82836914 253.61938477-252.82836914 53.59130859 0 104.46350098 16.61132813 146.73339843 46.57104492"
- ''' <summary>
- ''' 图标按钮,刷新,0.85x
- ''' </summary>
- Public Const IconButtonRefresh As String = "M875.52 148.48C783.36 56.32 655.36 0 512 0 291.84 0 107.52 138.24 30.72 332.8l122.88 46.08C204.8 230.4 348.16 128 512 128c107.52 0 199.68 40.96 271.36 112.64L640 384h384V0L875.52 148.48zM512 896c-107.52 0-199.68-40.96-271.36-112.64L384 640H0v384l148.48-148.48C240.64 967.68 368.64 1024 512 1024c220.16 0 404.48-138.24 481.28-332.8L870.4 645.12C819.2 793.6 675.84 896 512 896z"
- ''' <summary>
- ''' 图标按钮,软盘,1x
- ''' </summary>
- Public Const IconButtonSave As String = "M819.392 0L1024 202.752v652.16a168.96 168.96 0 0 1-168.832 168.768h-104.192a47.296 47.296 0 0 1-10.752 0H283.776a47.232 47.232 0 0 1-10.752 0H168.832A168.96 168.96 0 0 1 0 854.912V168.768A168.96 168.96 0 0 1 168.832 0h650.56z m110.208 854.912V242.112l-149.12-147.776H168.896c-41.088 0-74.432 33.408-74.432 74.432v686.144c0 41.024 33.344 74.432 74.432 74.432h62.4v-190.528c0-33.408 27.136-60.544 60.544-60.544h440.448c33.408 0 60.544 27.136 60.544 60.544v190.528h62.4c41.088 0 74.432-33.408 74.432-74.432z m-604.032 74.432h372.864v-156.736H325.568v156.736z m403.52-596.48a47.168 47.168 0 1 1 0 94.336H287.872a47.168 47.168 0 1 1 0-94.336h441.216z m0-153.728a47.168 47.168 0 1 1 0 94.4H287.872a47.168 47.168 0 1 1 0-94.4h441.216z"
- ''' <summary>
- ''' 图标按钮,信息,1.05x
- ''' </summary>
- Public Const IconButtonInfo As String = "M512 917.333333c223.861333 0 405.333333-181.472 405.333333-405.333333S735.861333 106.666667 512 106.666667 106.666667 288.138667 106.666667 512s181.472 405.333333 405.333333 405.333333z m0 106.666667C229.226667 1024 0 794.773333 0 512S229.226667 0 512 0s512 229.226667 512 512-229.226667 512-512 512z m-32-597.333333h64a21.333333 21.333333 0 0 1 21.333333 21.333333v320a21.333333 21.333333 0 0 1-21.333333 21.333333h-64a21.333333 21.333333 0 0 1-21.333333-21.333333V448a21.333333 21.333333 0 0 1 21.333333-21.333333z m0-192h64a21.333333 21.333333 0 0 1 21.333333 21.333333v64a21.333333 21.333333 0 0 1-21.333333 21.333333h-64a21.333333 21.333333 0 0 1-21.333333-21.333333v-64a21.333333 21.333333 0 0 1 21.333333-21.333333z"
- ''' <summary>
- ''' 图标按钮,列表,1x
- ''' </summary>
- Public Const IconButtonList As String = "M384 128h640v128H384zM160 192m-96 0a96 96 0 1 0 192 0 96 96 0 1 0-192 0ZM384 448h640v128H384zM160 512m-96 0a96 96 0 1 0 192 0 96 96 0 1 0-192 0ZM384 768h640v128H384zM160 832m-96 0a96 96 0 1 0 192 0 96 96 0 1 0-192 0Z"
- ''' <summary>
- ''' 图标按钮,文件夹,1.15x
- ''' </summary>
- Public Const IconButtonOpen As String = "M889.018182 418.909091H884.363636V316.509091a93.090909 93.090909 0 0 0-99.607272-89.832727h-302.545455l-93.090909-76.334546A46.545455 46.545455 0 0 0 358.865455 139.636364H146.152727A93.090909 93.090909 0 0 0 46.545455 229.469091V837.818182a46.545455 46.545455 0 0 0 46.545454 46.545454 46.545455 46.545455 0 0 0 16.756364-3.258181 109.381818 109.381818 0 0 0 25.134545 3.258181h586.472727a85.178182 85.178182 0 0 0 87.04-63.301818l163.374546-302.545454a46.545455 46.545455 0 0 0 5.585454-21.876364A82.385455 82.385455 0 0 0 889.018182 418.909091z m-744.727273-186.181818h198.283636l93.09091 76.334545a46.545455 46.545455 0 0 0 29.323636 10.705455h319.301818a12.101818 12.101818 0 0 1 6.516364 0V418.909091H302.545455a85.178182 85.178182 0 0 0-87.04 63.301818L139.636364 622.778182V232.727273a19.549091 19.549091 0 0 1 6.516363 0z m578.094546 552.029091a27.461818 27.461818 0 0 0-2.792728 6.516363H154.530909l147.083636-272.290909a27.461818 27.461818 0 0 0 2.792728-6.981818h565.061818z"
- ''' <summary>
- ''' 图标按钮,名片,1.1x
- ''' </summary>
- Public Const IconButtonCard As String = "M834.5 684.1c-31.2-70.4-98.9-120.9-179.1-127.3 63.5-8.5 112.6-63 112.6-128.8 0-71.8-58.2-130-130-130s-130 58.2-130 130c0 65.9 49 120.3 112.6 128.8-80.2 6.4-148 57-179.1 127.3-8.7 19.7 6 42 27.6 42 12.1 0 22.7-7.5 27.7-18.5 24.3-53.9 78.5-91.5 141.3-91.5s117 37.6 141.3 91.5c5 11.1 15.6 18.5 27.7 18.5 21.4 0 36.1-22.3 27.4-42zM567.9 427.9c0-38.6 31.4-70 70-70s70 31.4 70 70-31.4 70-70 70-70-31.4-70-70zM460.3 347.9H216.9c-16.6 0-30 13.4-30 30s13.4 30 30 30h243.3c16.6 0 30-13.4 30-30 0.1-16.5-13.4-30-29.9-30zM367.4 459.6H216.9c-16.6 0-30 13.4-30 30s13.4 30 30 30h150.4c16.6 0 30-13.4 30-30 0.1-16.6-13.4-30-29.9-30zM297.4 571.2H217c-16.6 0-30 13.4-30 30s13.4 30 30 30h80.4c16.6 0 30-13.4 30-30 0-16.5-13.5-30-30-30zM900 236v552H124V236h776m0-60H124c-33.1 0-60 26.9-60 60v552c0 33.1 26.9 60 60 60h776c33.1 0 60-26.9 60-60V236c0-33.1-26.9-60-60-60z"
- ''' <summary>
- ''' 图标按钮,×,0.85x
- ''' </summary>
- Public Const IconButtonCross As String = "F1 M 26.9166,22.1667L 37.9999,33.25L 49.0832,22.1668L 53.8332,26.9168L 42.7499,38L 53.8332,49.0834L 49.0833,53.8334L 37.9999,42.75L 26.9166,53.8334L 22.1666,49.0833L 33.25,38L 22.1667,26.9167L 26.9166,22.1667 Z"
- ''' <summary>
- ''' 图标按钮,Mojang,1.1x
- ''' </summary>
- Public Const IconButtonMojang As String = "M9.183,18.967c-0.109-2.239,1.336-5.119,3.92-4.96c3.657-0.027,7.319-0.044,10.977,0.005 c3.712,0.214,6.596,2.759,9.652,4.533c0.181-1.697-0.197-3.717,1.237-4.982c1.899,2.091,3.143,4.894,5.677,6.334 c1.577,0.805,2.973-0.668,4.221-1.44c1.55,2.305,2.108,5.075,2.622,7.752c0.657,3.438,0.947,6.925,1.111,10.413 c-1.734-0.733-3.355-1.708-4.971-2.671c-1.396-4.933-5.349-8.656-9.723-11.059c-3.46-1.817-7.752-2.185-11.338-0.52 c-3.761,1.593-6.285,5.666-5.891,9.75c0.121,4.577,3.17,8.765,7.391,10.456c7.746,3.285,16.407,2.234,24.521,1.243 c0.454,2.315-1.511,4.527-3.695,4.889c-10.577,0.038-21.148-0.011-31.725,0.022c-2.217,0.279-4.079-1.879-3.964-4.008 C9.167,36.141,9.216,27.556,9.183,18.967z M40.114,8.09c0.294-0.801,0.872-1.417,1.542-1.924c1.379,2.589,2.742,5.482,2.311,8.491 c-0.332,2.54-4.42,2.507-5.052,0.163C38.349,12.527,39.209,10.178,40.114,8.09z M0,53 l0.1,0 z"
- ''' <summary>
- ''' 图标按钮,用户,0.95x
- ''' </summary>
- Public Const IconButtonUser As String = "M660.338 528.065c63.61-46.825 105.131-121.964 105.131-206.83 0-141.7-115.29-256.987-256.997-256.987-141.706 0-256.998 115.288-256.998 256.987 0 85.901 42.52 161.887 107.456 208.562-152.1 59.92-260.185 207.961-260.185 381.077 0 21.276 17.253 38.53 38.53 38.53 21.278 0 38.53-17.254 38.53-38.53 0-183.426 149.232-332.671 332.667-332.671 1.589 0 3.113-0.207 4.694-0.244 0.8 0.056 1.553 0.244 2.362 0.244 183.434 0 332.664 149.245 332.664 332.671 0 21.276 17.255 38.53 38.533 38.53 21.277 0 38.53-17.254 38.53-38.53 0-174.885-110.354-324.13-264.917-382.809z m-331.803-206.83c0-99.22 80.72-179.927 179.935-179.927s179.937 80.708 179.937 179.927c0 99.203-80.721 179.91-179.937 179.91s-179.935-80.708-179.935-179.91z"
- ''' <summary>
- ''' 图标按钮,盾牌,1x
- ''' </summary>
- Public Const IconButtonShield As String = "M511.488256 95.184408c35.310345 22.516742 95.184408 55.78011 167.34033 84.437781 75.738131 29.681159 148.405797 40.93953 191.392304 45.033483v353.615193c0 73.691154-50.662669 164.781609-136.123938 244.101949C649.65917 901.181409 558.568716 942.12094 512 942.12094c-46.568716 0-137.65917-40.93953-222.096952-119.748126C204.441779 742.54073 153.77911 651.450275 153.77911 577.247376v-353.103448c42.474763-4.093953 116.165917-15.352324 191.904048-45.545227 75.226387-30.192904 133.565217-63.456272 165.805098-83.414293M512 0c-4.093953 0-8.187906 1.535232-11.258371 3.582209l-14.84058 10.234882c-1.023488 0.511744-67.550225 47.592204-170.410794 88.531735-100.813593 39.916042-198.556722 41.963018-199.58021 41.963018l-25.075462 0.511744c-10.746627 0.511744-18.934533 8.187906-18.934533 18.422789v414.000999c0 216.97951 286.064968 446.24088 440.09995 446.24088s440.09995-229.261369 440.09995-445.729136V163.758121c0-10.234883-8.69965-18.422789-18.934533-18.422789l-24.563718-0.511744c-1.023488 0-98.766617-2.046977-199.58021-41.963018-103.372314-40.93953-170.410795-88.01999-170.922538-88.531734L523.258371 3.582209c-3.070465-2.558721-7.164418-3.582209-11.258371-3.582209z M743.308346 410.930535l-260.477761 260.477761c-15.864068 15.864068-41.963018 15.864068-57.827087 0l-144.823588-144.823588c-15.864068-15.864068-15.864068-41.963018 0-57.827087 8.187906-8.187906 18.422789-11.770115 29.169415-11.770115 10.234883 0 20.981509 4.093953 29.169416 11.770115l115.654173 115.654173L685.993003 352.591704c15.864068-15.864068 41.963018-15.864068 57.827087 0 15.352324 16.375812 15.352324 42.474763-0.511744 58.338831z"
- ''' <summary>
- ''' 图标按钮,离线,0.85x
- ''' </summary>
- Public Const IconButtonOffline As String = "M533.293176 788.841412a60.235294 60.235294 0 1 1 85.202824 85.202823l-42.616471 42.586353c-129.355294 129.385412-339.124706 129.385412-468.510117 0-129.385412-129.385412-129.385412-339.124706 0-468.510117l42.586353-42.616471a60.235294 60.235294 0 1 1 85.202823 85.202824l-42.61647 42.586352a210.823529 210.823529 0 1 0 298.164706 298.164706l42.586352-42.61647z m255.548236-255.548236l42.61647-42.586352a210.823529 210.823529 0 1 0-298.164706-298.164706l-42.586352 42.61647a60.235294 60.235294 0 1 1-85.202824-85.202823l42.616471-42.586353c129.355294-129.385412 339.124706-129.385412 468.510117 0 129.385412 129.385412 129.385412 339.124706 0 468.510117l-42.586353 42.616471a60.235294 60.235294 0 1 1-85.202823-85.202824zM192.542118 192.542118a60.235294 60.235294 0 0 1 85.202823 0l553.712941 553.712941a60.235294 60.235294 0 0 1-85.202823 85.202823L192.542118 277.744941a60.235294 60.235294 0 0 1 0-85.202823z"
- ''' <summary>
- ''' 图标,服务端,1x
- ''' </summary>
- Public Const IconButtonServer As String = "M224 160a64 64 0 0 0-64 64v576a64 64 0 0 0 64 64h576a64 64 0 0 0 64-64V224a64 64 0 0 0-64-64H224z m0 384h576v256H224v-256z m192 96v64h320v-64H416z m-128 0v64h64v-64H288zM224 224h576v256H224V224z m192 96v64h320v-64H416z m-128 0v64h64v-64H288z"
- ''' <summary>
- ''' 图标,音符,1x
- ''' </summary>
- Public Const IconMusic As String = "M348.293565 716.53287V254.797913c0-41.672348 28.004174-78.358261 68.919652-90.37913L815.994435 40.826435c62.775652-18.610087 125.907478 26.579478 125.907478 89.933913v539.158261c8.013913 42.25113-8.94887 89.177043-47.014956 127.109565a232.848696 232.848696 0 0 1-170.785392 65.758609c-61.885217-2.938435-111.081739-33.435826-129.113043-80.050087-18.031304-46.614261-2.137043-102.177391 41.672348-145.853218a232.848696 232.848696 0 0 1 170.785391-65.80313c21.014261 1.024 40.514783 5.164522 57.878261 12.065391V233.338435c0-12.109913-10.551652-20.034783-20.569044-20.034783a24.620522 24.620522 0 0 0-5.787826 0.934957L439.785739 338.18713a19.545043 19.545043 0 0 0-14.825739 19.144348v438.984348H423.846957c11.53113 43.987478-5.164522 94.208-45.412174 134.322087a232.848696 232.848696 0 0 1-170.785392 65.758609c-61.885217-2.938435-111.081739-33.435826-129.113043-80.050087-18.031304-46.614261-2.137043-102.177391 41.672348-145.853218a232.848696 232.848696 0 0 1 170.785391-65.80313c20.791652 1.024 40.069565 5.075478 57.299478 11.842783z"
- ''' <summary>
- ''' 图标,播放,0.8x
- ''' </summary>
- Public Const IconPlay As String = "M803.904 463.936a55.168 55.168 0 0 1 0 96.128l-463.616 264.448C302.848 845.888 256 819.136 256 776.448V247.616c0-42.752 46.848-69.44 84.288-48.064l463.616 264.384z"
- End Class
- #End Region
- #Region "自定义类"
- ''' <summary>
- ''' 支持小数与常见类型隐式转换的颜色。
- ''' </summary>
- Public Class MyColor
- Public A As Double = 255
- Public R As Double = 0
- Public G As Double = 0
- Public B As Double = 0
- '类型转换
- Public Shared Widening Operator CType(str As String) As MyColor
- Return New MyColor(str)
- End Operator
- Public Shared Widening Operator CType(col As Color) As MyColor
- Return New MyColor(col)
- End Operator
- Public Shared Widening Operator CType(conv As MyColor) As Color
- Return Color.FromArgb(DoubleToByte(conv.A), DoubleToByte(conv.R), DoubleToByte(conv.G), DoubleToByte(conv.B))
- End Operator
- Public Shared Widening Operator CType(conv As MyColor) As System.Drawing.Color
- Return System.Drawing.Color.FromArgb(DoubleToByte(conv.A), DoubleToByte(conv.R), DoubleToByte(conv.G), DoubleToByte(conv.B))
- End Operator
- Public Shared Widening Operator CType(bru As SolidColorBrush) As MyColor
- Return New MyColor(bru.Color)
- End Operator
- Public Shared Widening Operator CType(conv As MyColor) As SolidColorBrush
- Return New SolidColorBrush(Color.FromArgb(DoubleToByte(conv.A), DoubleToByte(conv.R), DoubleToByte(conv.G), DoubleToByte(conv.B)))
- End Operator
- Public Shared Widening Operator CType(bru As Brush) As MyColor
- Return New MyColor(bru)
- End Operator
- Public Shared Widening Operator CType(conv As MyColor) As Brush
- Return New SolidColorBrush(Color.FromArgb(DoubleToByte(conv.A), DoubleToByte(conv.R), DoubleToByte(conv.G), DoubleToByte(conv.B)))
- End Operator
- '颜色运算
- Public Shared Operator +(a As MyColor, b As MyColor) As MyColor
- Return New MyColor With {.A = a.A + b.A, .B = a.B + b.B, .G = a.G + b.G, .R = a.R + b.R}
- End Operator
- Public Shared Operator -(a As MyColor, b As MyColor) As MyColor
- Return New MyColor With {.A = a.A - b.A, .B = a.B - b.B, .G = a.G - b.G, .R = a.R - b.R}
- End Operator
- Public Shared Operator *(a As MyColor, b As Double) As MyColor
- Return New MyColor With {.A = a.A * b, .B = a.B * b, .G = a.G * b, .R = a.R * b}
- End Operator
- Public Shared Operator /(a As MyColor, b As Double) As MyColor
- Return New MyColor With {.A = a.A / b, .B = a.B / b, .G = a.G / b, .R = a.R / b}
- End Operator
- Public Shared Operator =(a As MyColor, b As MyColor) As Boolean
- If IsNothing(a) AndAlso IsNothing(b) Then Return True
- If IsNothing(a) OrElse IsNothing(b) Then Return False
- Return a.A = b.A AndAlso a.R = b.R AndAlso a.G = b.G AndAlso a.B = b.B
- End Operator
- Public Shared Operator <>(a As MyColor, b As MyColor) As Boolean
- If IsNothing(a) AndAlso IsNothing(b) Then Return False
- If IsNothing(a) OrElse IsNothing(b) Then Return True
- Return Not (a.A = b.A AndAlso a.R = b.R AndAlso a.G = b.G AndAlso a.B = b.B)
- End Operator
- ''' <summary>
- ''' 获取两颜色间的百分比,基于 RGB 计算。
- ''' </summary>
- Public Shared Function Lerp(ValueA As MyColor, ValueB As MyColor, Percent As Double) As MyColor
- Return Round(ValueA * (1 - Percent) + ValueB * Percent, 6)
- End Function
- Public Shared Function Round(col As MyColor, Optional w As Integer = 0) As MyColor
- Return New MyColor With {.A = Math.Round(col.A, w), .R = Math.Round(col.R, w), .G = Math.Round(col.G, w), .B = Math.Round(col.B, w)}
- End Function
- ''' <summary>
- ''' 将一个数字限制为 0~255 的 Byte 值。
- ''' </summary>
- Public Shared Function DoubleToByte(d As Double) As Byte
- If d < 0 Then d = 0
- If d > 255 Then d = 255
- Return Math.Round(d)
- End Function
- '构造函数
- Public Sub New()
- End Sub
- Public Sub New(col As Color)
- Me.A = col.A
- Me.R = col.R
- Me.G = col.G
- Me.B = col.B
- End Sub
- Public Sub New(HexString As String)
- Dim StringColor As Media.Color = ColorConverter.ConvertFromString(HexString)
- A = StringColor.A
- R = StringColor.R
- G = StringColor.G
- B = StringColor.B
- End Sub
- Public Sub New(newA As Double, col As MyColor)
- Me.A = newA
- Me.R = col.R
- Me.G = col.G
- Me.B = col.B
- End Sub
- Public Sub New(newR As Double, newG As Double, newB As Double)
- Me.A = 255
- Me.R = newR
- Me.G = newG
- Me.B = newB
- End Sub
- Public Sub New(newA As Double, newR As Double, newG As Double, newB As Double)
- Me.A = newA
- Me.R = newR
- Me.G = newG
- Me.B = newB
- End Sub
- Public Sub New(brush As Brush)
- Dim Color As Color = CType(brush, SolidColorBrush).Color
- A = Color.A
- R = Color.R
- G = Color.G
- B = Color.B
- End Sub
- Public Sub New(brush As SolidColorBrush)
- Dim Color As Color = brush.Color
- A = Color.A
- R = Color.R
- G = Color.G
- B = Color.B
- End Sub
- Public Sub New(obj As Object)
- If obj Is Nothing Then
- A = 255 : R = 255 : G = 255 : B = 255
- Else
- If TypeOf obj Is SolidColorBrush Then
- '避免反复获取 Color 对象造成性能下降
- Dim Color As Color = CType(obj, SolidColorBrush).Color
- A = Color.A
- R = Color.R
- G = Color.G
- B = Color.B
- Else
- A = obj.A
- R = obj.R
- G = obj.G
- B = obj.B
- End If
- End If
- End Sub
- 'HSL
- Public Function Hue(v1 As Double, v2 As Double, vH As Double) As Double
- If vH < 0 Then vH += 1
- If vH > 1 Then vH -= 1
- If vH < 0.16667 Then Return v1 + (v2 - v1) * 6 * vH
- If vH < 0.5 Then Return v2
- If vH < 0.66667 Then Return v1 + (v2 - v1) * (4 - vH * 6)
- Return v1
- End Function
- Public Function FromHSL(sH As Double, sS As Double, sL As Double) As MyColor
- If sS = 0 Then
- R = sL * 2.55
- G = R
- B = R
- Else
- Dim H = sH / 360
- Dim S = sS / 100
- Dim L = sL / 100
- S = If(L < 0.5, S * L + L, S * (1.0 - L) + L)
- L = 2 * L - S
- R = 255 * Hue(L, S, H + 1 / 3)
- G = 255 * Hue(L, S, H)
- B = 255 * Hue(L, S, H - 1 / 3)
- End If
- A = 255
- Return Me
- End Function
- Public Function FromHSL2(sH As Double, sS As Double, sL As Double) As MyColor
- If sS = 0 Then
- R = sL * 2.55 : G = R : B = R
- Else
- '初始化
- sH = (sH + 3600000) Mod 360
- Dim cent As Double() = {
- +0.1, -0.06, -0.3, '0, 30, 60
- -0.19, -0.15, -0.24, '90, 120, 150
- -0.32, -0.09, +0.18, '180, 210, 240
- +0.05, -0.12, -0.02, '270, 300, 330
- +0.1, -0.06} '最后两位与前两位一致,加是变亮,减是变暗
- '计算色调对应的亮度片区
- Dim center As Double = sH / 30.0
- Dim intCenter As Integer = Math.Floor(center) '亮度片区编号
- center = 50 - (
- (1 - center + intCenter) * cent(intCenter) + (center - intCenter) * cent(intCenter + 1)
- ) * sS
- 'center = 50 + (cent(intCenter) + (center - intCenter) * (cent(intCenter + 1) - cent(intCenter))) * sS
- sL = If(sL < center, sL / center, 1 + (sL - center) / (100 - center)) * 50
- FromHSL(sH, sS, sL)
- End If
- A = 255
- Return Me
- End Function
- Public Overrides Function ToString() As String
- Return "(" & A & "," & R & "," & G & "," & B & ")"
- End Function
- Public Overrides Function Equals(obj As Object) As Boolean
- Return Me = obj
- End Function
- End Class
- ''' <summary>
- ''' 支持负数与浮点数的矩形。
- ''' </summary>
- Public Class MyRect
- '属性
- Public Property Width As Double = 0
- Public Property Height As Double = 0
- Public Property Left As Double = 0
- Public Property Top As Double = 0
- '构造函数
- Public Sub New()
- End Sub
- Public Sub New(left As Double, top As Double, width As Double, height As Double)
- Me.Left = left
- Me.Top = top
- Me.Width = width
- Me.Height = height
- End Sub
- End Class
- ''' <summary>
- ''' 模块加载状态枚举。
- ''' </summary>
- Public Enum LoadState
- Waiting
- Loading
- Finished
- Failed
- Interrupted
- End Enum
- ''' <summary>
- ''' 执行返回值。
- ''' </summary>
- Public Enum ProcessReturnValues
- ''' <summary>
- ''' 执行成功。
- ''' </summary>
- Success = 0
- ''' <summary>
- ''' 执行失败。
- ''' </summary>
- Fail = 1
- ''' <summary>
- ''' 执行时出现未经处理的异常。
- ''' </summary>
- Exception = 2
- ''' <summary>
- ''' 执行超时。
- ''' </summary>
- Timeout = 3
- ''' <summary>
- ''' 取消执行。可能是由于不满足执行的前置条件。
- ''' </summary>
- Cancel = 4
- ''' <summary>
- ''' 任务成功完成。
- ''' </summary>
- TaskDone = 5
- End Enum
- ''' <summary>
- ''' 可以使用 Equals 和等号的 List。
- ''' </summary>
- Public Class EqualableList(Of T)
- Inherits List(Of T)
- Public Overrides Function Equals(obj As Object) As Boolean
- If TryCast(obj, List(Of T)) Is Nothing Then
- '类型不同
- Return False
- Else
- '类型相同
- Dim objList As List(Of T) = obj
- If objList.Count <> Count Then Return False
- For i = 0 To objList.Count - 1
- If Not objList(i).Equals(Me(i)) Then Return False
- Next
- Return True
- End If
- End Function
- Public Shared Operator =(left As EqualableList(Of T), right As EqualableList(Of T)) As Boolean
- Return EqualityComparer(Of EqualableList(Of T)).Default.Equals(left, right)
- End Operator
- Public Shared Operator <>(left As EqualableList(Of T), right As EqualableList(Of T)) As Boolean
- Return Not left = right
- End Operator
- End Class
- #End Region
- #Region "文件"
- '=============================
- ' 注册表
- '=============================
- ''' <summary>
- ''' 读取注册表键。如果失败则返回默认值。
- ''' </summary>
- Public Function ReadReg(Key As String, Optional DefaultValue As String = "") As String
- Try
- Return If(My.Computer.Registry.CurrentUser.OpenSubKey("Software\" & RegFolder, False)?.GetValue(Key), DefaultValue)
- Catch ex As Exception
- Log(ex, "读取注册表出错:" & Key, NotifyLevel.AllUsers)
- Return DefaultValue
- End Try
- End Function
- ''' <summary>
- ''' 写入注册表键。
- ''' </summary>
- Public Sub WriteReg(Key As String, Value As String, Optional ThrowException As Boolean = False)
- Try
- Dim SubKey As Microsoft.Win32.RegistryKey = My.Computer.Registry.CurrentUser.OpenSubKey("Software\" & RegFolder, True)
- If SubKey Is Nothing Then SubKey = My.Computer.Registry.CurrentUser.CreateSubKey("Software\" & RegFolder) '如果不存在就创建
- SubKey.SetValue(Key, Value)
- Catch ex As Exception
- Log(ex, "写入注册表出错:" & Key, If(ThrowException, NotifyLevel.AllUsers, NotifyLevel.DevelopOnly))
- If ThrowException Then Throw
- End Try
- End Sub
- ''' <summary>
- ''' 是否存在某个注册表键。
- ''' </summary>
- Public Function HasReg(Key As String) As Boolean
- Return ReadReg(Key, Nothing) IsNot Nothing
- End Function
- ''' <summary>
- ''' 删除注册表键。
- ''' </summary>
- Public Sub DeleteReg(Key As String, Optional ThrowException As Boolean = False)
- Try
- Dim SubKey As Microsoft.Win32.RegistryKey = My.Computer.Registry.CurrentUser.OpenSubKey("Software\" & RegFolder, True)
- If SubKey?.GetValue(Key) Is Nothing Then Return
- SubKey.DeleteValue(Key)
- Catch ex As Exception
- Log(ex, "删除注册表出错:" & Key, If(ThrowException, NotifyLevel.AllUsers, NotifyLevel.DevelopOnly))
- If ThrowException Then Throw
- End Try
- End Sub
- '=============================
- ' ini
- '=============================
- Private ReadOnly IniCache As New ConcurrentDictionary(Of String, ConcurrentDictionary(Of String, String))
- ''' <summary>
- ''' 清除某 ini 文件的运行时缓存。
- ''' </summary>
- ''' <param name="FileName">文件完整路径或简写文件名。简写将会使用“ApplicationName\文件名.ini”作为路径。</param>
- Public Sub IniClearCache(FileName As String)
- If Not FileName.Contains(":\") Then FileName = $"{PathExeFolder}PCL\{FileName}.ini"
- IniCache.Remove(FileName)
- End Sub
- ''' <summary>
- ''' 获取 ini 文件缓存。如果没有,则新读取 ini 文件内容。
- ''' 在文件不存在或读取失败时返回 Nothing。
- ''' </summary>
- ''' <param name="FileName">文件完整路径或简写文件名。简写将会使用“ApplicationName\文件名.ini”作为路径。</param>
- Private Function IniGetContent(FileName As String) As ConcurrentDictionary(Of String, String)
- Try
- '还原文件路径
- If Not FileName.Contains(":\") Then FileName = $"{PathExeFolder}PCL\{FileName}.ini"
- '检索缓存
- Dim Cache As ConcurrentDictionary(Of String, String) = Nothing
- If IniCache.TryGetValue(FileName, Cache) Then Return Cache
- '读取文件
- If Not File.Exists(FileName) Then Return Nothing
- Dim Ini As New ConcurrentDictionary(Of String, String)
- For Each Line In ReadFile(FileName).Split(vbCrLf.ToArray(), StringSplitOptions.RemoveEmptyEntries)
- Dim Index As Integer = Line.IndexOfF(":")
- If Index > 0 Then Ini(Line.Substring(0, Index)) = Line.Substring(Index + 1) '可能会有重复键,见 #3616
- Next
- IniCache(FileName) = Ini
- Return Ini
- Catch ex As Exception
- Log(ex, $"生成 ini 文件缓存失败({FileName})", NotifyLevel.AllUsers)
- Return Nothing
- End Try
- End Function
- ''' <summary>
- ''' 读取 ini 文件。这可能会使用到缓存。
- ''' </summary>
- ''' <param name="FileName">文件完整路径或简写文件名。简写将会使用“ApplicationName\文件名.ini”作为路径。</param>
- ''' <param name="Key">键。</param>
- ''' <param name="DefaultValue">没有找到键时返回的默认值。</param>
- Public Function ReadIni(FileName As String, Key As String, Optional DefaultValue As String = "") As String
- Dim Content = IniGetContent(FileName)
- If Content Is Nothing Then Return DefaultValue
- Return Content.GetOrDefault(Key, DefaultValue)
- End Function
- ''' <summary>
- ''' 判断 ini 文件中是否包含某个键。这可能会使用到缓存。
- ''' </summary>
- Public Function HasIniKey(FileName As String, Key As String) As Boolean
- Dim Content = IniGetContent(FileName)
- Return Content IsNot Nothing AndAlso Content.ContainsKey(Key)
- End Function
- ''' <summary>
- ''' 从 ini 文件中移除某个键。这会更新缓存。
- ''' </summary>
- Public Sub DeleteIniKey(FileName As String, Key As String)
- WriteIni(FileName, Key, Nothing)
- End Sub
- ''' <summary>
- ''' 写入 ini 文件,这会更新缓存。
- ''' 若 Value 为 Nothing,则删除该键。
- ''' </summary>
- ''' <param name="FileName">文件完整路径或简写文件名。简写将会使用“ApplicationName\文件名.ini”作为路径。</param>
- ''' <param name="Key">键。</param>
- ''' <param name="Value">值。</param>
- Public Sub WriteIni(FileName As String, Key As String, Value As String)
- Try
- '预处理
- If Key.Contains(":") Then Throw New Exception($"尝试写入 ini 文件 {FileName} 的键名中包含了冒号:{Key}")
- Key = Key.ReplaceLineEndings("")
- Value = Value?.ReplaceLineEndings("")
- '获取目前文件
- Dim Content = IniGetContent(FileName)
- If Content Is Nothing Then Content = New ConcurrentDictionary(Of String, String)
- '更新值
- If Value Is Nothing Then
- If Not Content.Remove(Key) Then Return '无需处理
- Else
- Dim ExistingValue As String = Nothing
- If Content.TryGetValue(Key, ExistingValue) AndAlso ExistingValue = Value Then Return '无需处理
- Content(Key) = Value
- End If
- '写入文件
- Dim FileContent As New StringBuilder
- For Each Pair In Content
- FileContent.Append(Pair.Key)
- FileContent.Append(":")
- FileContent.Append(Pair.Value)
- FileContent.Append(vbCrLf)
- Next
- If Not FileName.Contains(":\") Then FileName = $"{PathExeFolder}PCL\{FileName}.ini"
- '处理相对路径
- FileName = If(FileName.Contains(":\"), FileName, PathExeFolder & FileName)
- FileUtils.Write(FileName, FileContent.ToString)
- Catch ex As Exception
- Log(ex, $"写入文件失败({FileName} → {Key}:{Value})", NotifyLevel.AllUsers)
- End Try
- End Sub
- '路径处理
- ''' <summary>
- ''' 从文件路径或者 URL 获取不包含文件名的路径,或获取文件夹的父文件夹路径。
- ''' 取决于原路径格式,路径以 / 或 \ 结尾。
- ''' 不包含路径将会抛出异常。
- ''' </summary>
- Public Function GetPathFromFullPath(FullName As String) As String
- If String.IsNullOrEmpty(FullName) OrElse Not (FullName.Contains("\") OrElse FullName.Contains("/")) Then Throw New ArgumentException("参数不包含路径:" & FullName)
- If FullName.EndsWithF("\") OrElse FullName.EndsWithF("/") Then
- '是文件夹路径
- Dim IsRight As Boolean = FullName.EndsWithF("\")
- FullName = Left(FullName, Len(FullName) - 1)
- GetPathFromFullPath = Left(FullName, FullName.LastIndexOfAny({"\", "/"})) & If(IsRight, "\", "/")
- Else
- '是文件路径
- GetPathFromFullPath = Left(FullName, FullName.LastIndexOfAny({"\", "/"}) + 1)
- If GetPathFromFullPath = "" Then Throw New Exception("不包含路径:" & FullName)
- End If
- End Function
- ''' <summary>
- ''' 从文件路径或者 Url 获取不包含路径的文件名。不包含文件名将会抛出异常。
- ''' </summary>
- Public Function GetFileNameFromPath(FilePath As String) As String
- FilePath = FilePath.Replace("/", "\")
- If FilePath.EndsWithF("\") Then Throw New Exception("不包含文件名:" & FilePath)
- If FilePath.Contains("?") Then FilePath = FilePath.Substring(0, FilePath.IndexOfF("?")) '去掉网络参数后的 ?
- If FilePath.Contains("\") Then FilePath = FilePath.Substring(FilePath.LastIndexOfF("\") + 1)
- Dim length As Integer = FilePath.Length
- If length = 0 Then Throw New Exception("不包含文件名:" & FilePath)
- Return FilePath
- End Function
- ''' <summary>
- ''' 从文件夹路径获取文件夹名。
- ''' </summary>
- Public Function GetFolderNameFromPath(FolderPath As String) As String
- If FolderPath.EndsWithF(":\") OrElse FolderPath.EndsWithF(":\\") Then Return FolderPath.Substring(0, 1)
- If FolderPath.EndsWithF("\") OrElse FolderPath.EndsWithF("/") Then FolderPath = Left(FolderPath, FolderPath.Length - 1)
- Return GetFileNameFromPath(FolderPath)
- End Function
- '读取、复制文件
- ''' <summary>
- ''' 复制文件。会自动创建文件夹、会覆盖已有的文件。
- ''' </summary>
- Public Sub CopyFile(FromPath As String, ToPath As String)
- Try
- '还原文件路径
- FromPath = If(FromPath.Contains(":\"), FromPath, PathExeFolder & FromPath)
- ToPath = If(ToPath.Contains(":\"), ToPath, PathExeFolder & ToPath)
- '如果复制同一个文件则跳过
- If FromPath = ToPath Then Return
- '确保目录存在
- DirectoryUtils.Create(ToPath, isFilePath:=True)
- '复制文件
- File.Copy(FromPath, ToPath, True)
- Catch ex As Exception
- Throw New Exception("复制文件出错:" & FromPath & " → " & ToPath, ex)
- End Try
- End Sub
- ''' <summary>
- ''' 读取文件,如果失败则返回空数组。
- ''' </summary>
- Public Function ReadFileBytes(FilePath As String, Optional Encoding As Encoding = Nothing) As Byte()
- Try
- '还原文件路径
- If Not FilePath.Contains(":\") Then FilePath = PathExeFolder & FilePath
- If File.Exists(FilePath) Then
- Dim FileBytes As Byte()
- Using ReadStream As New FileStream(FilePath, FileMode.Open, FileAccess.Read, FileShare.ReadWrite) '支持读取使用中的文件
- ReDim FileBytes(ReadStream.Length - 1)
- ReadStream.Read(FileBytes, 0, ReadStream.Length)
- End Using
- Return FileBytes
- Else
- Log("[System] 欲读取的文件不存在,已返回空内容:" & FilePath)
- Return {}
- End If
- Catch ex As Exception
- Log(ex, "读取文件出错:" & FilePath)
- Return {}
- End Try
- End Function
- ''' <summary>
- ''' 读取文件,如果失败则返回空字符串。
- ''' </summary>
- ''' <param name="FilePath">文件完整或相对路径。</param>
- Public Function ReadFile(FilePath As String, Optional Encoding As Encoding = Nothing) As String
- Dim FileBytes = ReadFileBytes(FilePath)
- ReadFile = If(Encoding Is Nothing, DecodeBytes(FileBytes), Encoding.GetString(FileBytes))
- End Function
- ''' <summary>
- ''' 读取流中的所有文本。
- ''' </summary>
- Public Function ReadFile(Stream As Stream, Optional Encoding As Encoding = Nothing) As String
- Try
- Dim srcBuf As Byte() = New Byte(16384) {}
- Dim DataCount As Integer = Stream.Read(srcBuf, 0, 16384)
- Dim Result As New List(Of Byte)
- While DataCount > 0
- If DataCount > 0 Then Result.AddRange(srcBuf.ToList.GetRange(0, DataCount))
- DataCount = Stream.Read(srcBuf, 0, 16384)
- End While
- Dim Bts = Result.ToArray
- Return If(Encoding, GetEncoding(Bts)).GetString(Bts)
- Catch ex As Exception
- Log(ex, "读取流出错")
- Return ""
- End Try
- End Function
- '文件编码
- ''' <summary>
- ''' 根据字节数组分析其编码。
- ''' </summary>
- Public Function GetEncoding(Bytes As Byte()) As Encoding
- Dim Length As Integer = Bytes.Count
- If Length < 3 Then Return New UTF8Encoding(False) '不带 BOM 的 UTF8
- '根据 BOM 判断编码
- If Bytes(0) >= &HEF Then
- '有 BOM 类型
- If Bytes(0) = &HEF AndAlso Bytes(1) = &HBB Then
- Return New UTF8Encoding(True) '带 BOM 的 UTF8
- ElseIf Bytes(0) = &HFE AndAlso Bytes(1) = &HFF Then
- Return Encoding.BigEndianUnicode
- ElseIf Bytes(0) = &HFF AndAlso Bytes(1) = &HFE Then
- Return Encoding.Unicode
- Else
- Return Encoding.GetEncoding("GB18030")
- End If
- End If
- '无 BOM 文件:GB18030(ANSI)或 UTF8
- Dim UTF8 = Encoding.UTF8.GetString(Bytes)
- Dim ErrorChar As Char = Encoding.UTF8.GetString({239, 191, 189}).ToCharArray()(0)
- If UTF8.Contains(ErrorChar) Then
- Return Encoding.GetEncoding("GB18030")
- Else
- Return New UTF8Encoding(False) '不带 BOM 的 UTF8
- End If
- End Function
- ''' <summary>
- ''' 解码 Bytes。
- ''' </summary>
- Public Function DecodeBytes(Bytes As Byte()) As String
- Dim Length As Integer = Bytes.Length
- If Length < 3 Then Return Encoding.UTF8.GetString(Bytes)
- '根据 BOM 判断编码
- If Bytes(0) >= &HEF Then
- '有 BOM 类型
- If Bytes(0) = &HEF AndAlso Bytes(1) = &HBB Then
- Return Encoding.UTF8.GetString(Bytes, 3, Length - 3)
- ElseIf Bytes(0) = &HFE AndAlso Bytes(1) = &HFF Then
- Return Encoding.BigEndianUnicode.GetString(Bytes, 3, Length - 3)
- ElseIf Bytes(0) = &HFF AndAlso Bytes(1) = &HFE Then
- Return Encoding.Unicode.GetString(Bytes, 3, Length - 3)
- Else
- Return Encoding.GetEncoding("GB18030").GetString(Bytes, 3, Length - 3)
- End If
- End If
- '无 BOM 文件:GB18030(ANSI)或 UTF8
- Dim UTF8 = Encoding.UTF8.GetString(Bytes)
- Dim ErrorChar As Char = Encoding.UTF8.GetString({239, 191, 189}).ToCharArray()(0)
- If UTF8.Contains(ErrorChar) Then
- Return Encoding.GetEncoding("GB18030").GetString(Bytes)
- Else
- Return UTF8
- End If
- End Function
- '对话框
- ''' <summary>
- ''' 弹出保存对话框并且要求保存位置,返回用户输入的完整路径。
- ''' </summary>
- ''' <param name="FileFilter">要求的格式。如:“常用图片文件(*.png;*.jpg)|*.png;*.jpg”。</param>
- ''' <param name="Title">弹窗的标题。</param>
- ''' <param name="FileName">默认的文件名。</param>
- Public Function SelectSaveFile(Title As String, FileName As String, Optional FileFilter As String = Nothing, Optional InitialDirectory As String = Nothing) As String
- Using fileDialog As New Forms.SaveFileDialog
- fileDialog.AddExtension = True
- fileDialog.AutoUpgradeEnabled = True
- fileDialog.Title = Title
- fileDialog.FileName = FileName
- If FileFilter IsNot Nothing Then fileDialog.Filter = FileFilter
- If Not String.IsNullOrEmpty(InitialDirectory) AndAlso Directory.Exists(InitialDirectory) Then fileDialog.InitialDirectory = InitialDirectory
- fileDialog.ShowDialog()
- SelectSaveFile = If(fileDialog.FileName.Contains(":\"), fileDialog.FileName, "")
- Log("[UI] 选择文件返回:" & SelectSaveFile)
- End Using
- End Function
- ''' <summary>
- ''' 弹出选取文件对话框,要求选择一个文件。
- ''' </summary>
- ''' <param name="FileFilter">要求的格式。如:“常用图片文件(*.png;*.jpg)|*.png;*.jpg”。</param>
- ''' <param name="Title">弹窗的标题。</param>
- Public Function SelectFile(FileFilter As String, Title As String, Optional InitialDirectory As String = Nothing) As String
- Using fileDialog As New Forms.OpenFileDialog
- fileDialog.AddExtension = True
- fileDialog.AutoUpgradeEnabled = True
- fileDialog.CheckFileExists = True
- fileDialog.Filter = FileFilter
- fileDialog.Multiselect = False
- fileDialog.Title = Title
- fileDialog.ValidateNames = True
- If Not String.IsNullOrEmpty(InitialDirectory) AndAlso Directory.Exists(InitialDirectory) Then fileDialog.InitialDirectory = InitialDirectory
- fileDialog.ShowDialog()
- Log("[UI] 选择单个文件返回:" & fileDialog.FileName)
- Return fileDialog.FileName
- End Using
- End Function
- ''' <summary>
- ''' 弹出选取文件对话框,要求选择多个文件。
- ''' </summary>
- ''' <param name="FileFilter">要求的格式。如:“常用图片文件(*.png;*.jpg)|*.png;*.jpg”。</param>
- ''' <param name="Title">弹窗的标题。</param>
- Public Function SelectFiles(FileFilter As String, Title As String) As String()
- Using fileDialog As New Forms.OpenFileDialog
- fileDialog.AddExtension = True
- fileDialog.AutoUpgradeEnabled = True
- fileDialog.CheckFileExists = True
- fileDialog.Filter = FileFilter
- fileDialog.Multiselect = True
- fileDialog.Title = Title
- fileDialog.ValidateNames = True
- fileDialog.ShowDialog()
- Log("[UI] 选择多个文件返回:" & fileDialog.FileNames.Join(","))
- Return fileDialog.FileNames
- End Using
- End Function
- ''' <summary>
- ''' 弹出选取文件夹对话框,要求选取文件夹。
- ''' 返回以 \ 结尾的完整路径,如果没有选择则返回空字符串。
- ''' </summary>
- Public Function SelectFolder(Optional Title As String = "选择文件夹") As String
- Dim folderDialog As New Ookii.Dialogs.Wpf.VistaFolderBrowserDialog With {.ShowNewFolderButton = True, .RootFolder = Environment.SpecialFolder.Desktop, .Description = Title, .UseDescriptionForTitle = True}
- folderDialog.ShowDialog()
- SelectFolder = If(String.IsNullOrEmpty(folderDialog.SelectedPath), "", folderDialog.SelectedPath & If(folderDialog.SelectedPath.EndsWithF("\"), "", "\"))
- Log("[UI] 选择文件夹返回:" & SelectFolder)
- End Function
- '文件校验
- ''' <summary>
- ''' 检查是否拥有某一文件夹的 I/O 权限。如果文件夹不存在,会返回 False。
- ''' </summary>
- Public Function CheckPermission(Folder As String) As Boolean
- Try
- If String.IsNullOrEmpty(Folder) Then Return False
- If Not Folder.EndsWithF("\") Then Folder += "\"
- If Folder.EndsWithF(":\System Volume Information\") OrElse Folder.EndsWithF(":\$RECYCLE.BIN\") Then Return False
- If Not Directory.Exists(Folder) Then Return False
- Dim FileName As String = "CheckPermission" & GetUuid()
- If File.Exists(Folder & FileName) Then File.Delete(Folder & FileName)
- File.Create(Folder & FileName).Dispose()
- File.Delete(Folder & FileName)
- Return True
- Catch ex As Exception
- Log(ex, "没有对文件夹 " & Folder & " 的权限,请尝试以管理员权限运行 PCL")
- Return False
- End Try
- End Function
- ''' <summary>
- ''' 检查是否拥有某一文件夹的 I/O 权限。如果出错,则抛出异常。
- ''' </summary>
- Public Sub CheckPermissionWithException(Folder As String)
- If String.IsNullOrWhiteSpace(Folder) Then Throw New ArgumentNullException("文件夹名不能为空!")
- If Not Folder.EndsWithF("\") Then Folder += "\"
- If Not Directory.Exists(Folder) Then Throw New DirectoryNotFoundException("文件夹不存在!")
- If File.Exists(Folder & "CheckPermission") Then File.Delete(Folder & "CheckPermission")
- File.Create(Folder & "CheckPermission").Dispose()
- File.Delete(Folder & "CheckPermission")
- End Sub
- ''' <summary>
- ''' 获取文件 MD5,若失败则返回空字符串。
- ''' </summary>
- Public Function GetFileMD5(FilePath As String) As String
- Dim Retried As Boolean = False
- Re:
- Try
- Using File As New FileStream(FilePath, FileMode.Open, FileAccess.Read, FileShare.ReadWrite)
- Using h = MD5Cng.Create()
- Return BitConverter.ToString(h.ComputeHash(File)).Replace("-", "").Lower()
- End Using
- End Using
- Catch ex As Exception
- If Retried OrElse TypeOf ex Is FileNotFoundException Then
- Log(ex, "获取文件 MD5 失败:" & FilePath)
- Return ""
- Else
- Retried = True
- Log(ex, "获取文件 MD5 可重试失败:" & FilePath, NotifyLevel.Silent)
- Thread.Sleep(RandomInteger(200, 500))
- GoTo Re
- End If
- End Try
- End Function
- ''' <summary>
- ''' 获取文件 SHA512,若失败则返回空字符串。
- ''' </summary>
- Public Function GetFileSHA512(FilePath As String) As String
- Dim Retried As Boolean = False
- Re:
- Try
- Using File As New FileStream(FilePath, FileMode.Open, FileAccess.Read, FileShare.ReadWrite)
- Using h = SHA512Cng.Create()
- Return BitConverter.ToString(h.ComputeHash(File)).Replace("-", "").Lower()
- End Using
- End Using
- Catch ex As Exception
- If Retried OrElse TypeOf ex Is FileNotFoundException Then
- Log(ex, "获取文件 SHA512 失败:" & FilePath)
- Return ""
- Else
- Retried = True
- Log(ex, "获取文件 SHA512 可重试失败:" & FilePath, NotifyLevel.Silent)
- Thread.Sleep(RandomInteger(200, 500))
- GoTo Re
- End If
- End Try
- End Function
- ''' <summary>
- ''' 获取文件 SHA256,若失败则返回空字符串。
- ''' </summary>
- Public Function GetFileSHA256(FilePath As String) As String
- Dim Retry As Boolean = False
- Re:
- Try
- Using File As New FileStream(FilePath, FileMode.Open, FileAccess.Read, FileShare.ReadWrite)
- Using h = SHA256Cng.Create()
- Return BitConverter.ToString(h.ComputeHash(File)).Replace("-", "").Lower()
- End Using
- End Using
- Catch ex As Exception
- If Retry OrElse TypeOf ex Is FileNotFoundException Then
- Log(ex, "获取文件 SHA256 失败:" & FilePath)
- Return ""
- Else
- Retry = True
- Log(ex, "获取文件 SHA256 可重试失败:" & FilePath, NotifyLevel.Silent)
- Thread.Sleep(RandomInteger(200, 500))
- GoTo Re
- End If
- End Try
- End Function
- ''' <summary>
- ''' 获取文件 SHA1,若失败则返回空字符串。
- ''' </summary>
- Public Function GetFileSHA1(FilePath As String) As String
- Dim Retry As Boolean = False
- Re:
- Try
- Using File As New FileStream(FilePath, FileMode.Open, FileAccess.Read, FileShare.ReadWrite)
- Using h = SHA1Cng.Create()
- Return BitConverter.ToString(h.ComputeHash(File)).Replace("-", "").Lower()
- End Using
- End Using
- Catch ex As Exception
- If Retry OrElse TypeOf ex Is FileNotFoundException Then
- Log(ex, "获取文件 SHA1 失败:" & FilePath)
- Return ""
- Else
- Retry = True
- Log(ex, "获取文件 SHA1 可重试失败:" & FilePath, NotifyLevel.Silent)
- Thread.Sleep(RandomInteger(200, 500))
- GoTo Re
- End If
- End Try
- End Function
- ''' <summary>
- ''' 文件的校验规则。
- ''' </summary>
- Public Class FileChecker
- ''' <summary>
- ''' 文件的准确大小。
- ''' 不检查则为 -1。
- ''' </summary>
- Public ActualSize As Long = -1
- ''' <summary>
- ''' 文件的最小大小。
- ''' 不检查则为 -1。
- ''' </summary>
- Public MinSize As Long = -1
- ''' <summary>
- ''' 文件的 MD5、SHA1 或 SHA256。会根据输入字符串的长度自动判断种类。
- ''' 不检查则为 Nothing。
- ''' </summary>
- Public Hash As String = Nothing
- ''' <summary>
- ''' 是否可以使用已经存在的文件。
- ''' </summary>
- Public CanUseExistsFile As Boolean = True
- ''' <summary>
- ''' 是否要求为 JSON 文件。
- ''' 即,开头结尾必须为 {} 或 []。
- ''' </summary>
- Public IsJson As Boolean = False
- Public Sub New(Optional MinSize As Long = -1, Optional ActualSize As Long = -1, Optional Hash As String = Nothing, Optional CanUseExistsFile As Boolean = True, Optional IsJson As Boolean = False)
- Me.ActualSize = ActualSize
- Me.MinSize = MinSize
- Me.Hash = Hash
- Me.CanUseExistsFile = CanUseExistsFile
- Me.IsJson = IsJson
- End Sub
- ''' <summary>
- ''' 检查文件。若成功则返回 Nothing,失败则返回错误的描述文本,描述文本不以句号结尾。不会抛出错误。
- ''' </summary>
- Public Function Check(LocalPath As String) As String
- Try
- Dim Info As New FileInfo(LocalPath)
- If Not Info.Exists Then Return "文件不存在:" & LocalPath
- Dim FileSize As Long = Info.Length
- If ActualSize >= 0 AndAlso ActualSize <> FileSize Then
- Return $"文件大小应为 {ActualSize} B,实际为 {FileSize} B" &
- If(FileSize < 2000, ",内容为:" & ReadFile(LocalPath), "")
- End If
- If MinSize >= 0 AndAlso MinSize > FileSize Then
- Return $"文件大小应大于 {MinSize} B,实际为 {FileSize} B" &
- If(FileSize < 2000, ",内容为:" & ReadFile(LocalPath), "")
- End If
- If Not String.IsNullOrEmpty(Hash) Then
- If Hash.Length < 35 Then 'MD5
- If Hash.Lower <> GetFileMD5(LocalPath) Then Return "文件 MD5 应为 " & Hash & ",实际为 " & GetFileMD5(LocalPath)
- ElseIf Hash.Length = 64 Then 'SHA256
- If Hash.Lower <> GetFileSHA256(LocalPath) Then Return "文件 SHA256 应为 " & Hash & ",实际为 " & GetFileSHA256(LocalPath)
- Else 'SHA1 (40)
- If Hash.Lower <> GetFileSHA1(LocalPath) Then Return "文件 SHA1 应为 " & Hash & ",实际为 " & GetFileSHA1(LocalPath)
- End If
- End If
- If IsJson Then
- Dim Content As String = ReadFile(LocalPath)
- If Content = "" Then Throw New Exception("读取到的文件为空")
- Try
- GetJson(Content)
- Catch ex As Exception
- Throw New Exception("不是有效的 json 文件", ex)
- End Try
- End If
- Return Nothing
- Catch ex As Exception
- Log(ex, "检查文件出错")
- Return ex.GetBrief()
- End Try
- End Function
- End Class
- '压缩文件
- ''' <summary>
- ''' 尝试根据后缀名判断文件种类并解压文件,支持 gz 与 zip,会尝试将 jar 以 zip 方式解压。
- ''' 会尝试创建目标文件夹;会覆盖已有文件,不会删除多余文件。
- ''' 会先使用 UTF-8 解压,失败后换用 GB18030 解压。
- ''' </summary>
- Public Sub ExtractCompressedFile(CompressFilePath As String, DestDirectory As String, Optional ProgressIncrementHandler As Action(Of Double) = Nothing)
- DestDirectory = DirectoryUtils.ToDirectoryFormat(DestDirectory)
- DirectoryUtils.Create(DestDirectory)
- '解压 gz(gz 不需要考虑编码)
- If CompressFilePath.EndsWithF(".gz", True) Then
- Using stream As New GZipStream(New FileStream(CompressFilePath, FileMode.Open, FileAccess.Read, FileShare.Read), CompressionMode.Decompress)
- Using decompressedFile As New FileStream(
- DestDirectory & GetFileNameFromPath(CompressFilePath).Lower.Replace(".tar", "").Replace(".gz", ""), FileMode.Create, FileAccess.Write)
- stream.CopyTo(decompressedFile)
- End Using
- End Using
- Return
- End If
- '解压 zip
- Dim TryExtractZip =
- Sub(Encoding As Encoding)
- Using Archive = ZipFile.Open(CompressFilePath, ZipArchiveMode.Read, Encoding)
- Dim EntryCount = Archive.Entries.Count
- For Each Entry In Archive.Entries
- If ProgressIncrementHandler IsNot Nothing AndAlso EntryCount > 0 Then ProgressIncrementHandler(1 / EntryCount)
- Dim Destination As String = Path.Combine(DestDirectory, Entry.FullName)
- If Not Path.GetFullPath(Destination).StartsWithF(Path.GetFullPath(DestDirectory), True) Then Continue For 'ZipSlip 漏洞修复
- If DirectoryUtils.IsDirectoryFormat(Destination) Then Continue For '不创建空文件夹
- Destination = FileUtils.ShortenPath(Destination)
- DirectoryUtils.Create(Destination, isFilePath:=True)
- Entry.ExtractToFile(Destination, True) '#7329
- Next
- End Using
- End Sub
- Try
- TryExtractZip(New UTF8Encoding(False, True))
- Catch ex As Exception
- Log(ex, $"首次解压尝试失败,将更换编码并重试({CompressFilePath} → {DestDirectory})")
- Try
- TryExtractZip(Encoding.GetEncoding("GB18030"))
- Catch
- Throw
- End Try
- End Try
- End Sub
- ''' <summary>
- ''' 将多个文件打包为一个压缩文件。
- ''' 这些文件会被直接放在压缩包根目录下。
- ''' </summary>
- Public Sub CreateCompressedFile(OutputFullPath As String, SourceFiles As IEnumerable(Of String))
- DirectoryUtils.Create(OutputFullPath, isFilePath:=True)
- Using ZipStream As New FileStream(OutputFullPath, FileMode.Create)
- Using Archive As New ZipArchive(ZipStream, ZipArchiveMode.Create)
- For Each FilePath In SourceFiles
- If Not File.Exists(FilePath) Then Return
- Using SourceStream As New FileStream(FilePath, FileMode.Open, FileAccess.Read, FileShare.Read),
- EntryStream As Stream = Archive.CreateEntry(Path.GetFileName(FilePath), CompressionLevel.Optimal).Open()
- SourceStream.CopyTo(EntryStream)
- End Using
- Next
- End Using
- End Using
- End Sub
- ''' <summary>
- ''' 删除文件夹,返回删除的文件个数。通过参数选择是否抛出异常。
- ''' </summary>
- Public Function DeleteDirectory(Folder As String, Optional IgnoreIssue As Boolean = False) As Integer
- If Not Directory.Exists(Folder) Then Return 0
- If Not Folder.EndsWithF("\") Then Folder &= "\"
- If Folder.EndsWithF(":\") OrElse
- Folder = Environment.GetFolderPath(Environment.SpecialFolder.Desktop) & "\" OrElse
- Folder = Environment.GetFolderPath(Environment.SpecialFolder.DesktopDirectory) & "\" OrElse
- Folder = Environment.GetFolderPath(Environment.SpecialFolder.MyDocuments) & "\" Then '#7030
- Throw New UnauthorizedAccessException("这是重要的系统文件夹,无法删除:" & Folder)
- End If
- '实际删除
- Dim DeletedCount As Integer = 0
- Dim Files As String()
- Try
- Files = Directory.GetFiles(Folder)
- Catch ex As DirectoryNotFoundException '#4549,也可能已被其他线程删除
- If Directory.Exists(Folder) Then
- Log(ex, $"疑似为孤立符号链接,尝试直接删除({Folder})", NotifyLevel.DevelopOnly)
- Directory.Delete(Folder)
- End If
- Return DeletedCount
- End Try
- For Each FilePath As String In Files
- Dim RetriedFile As Boolean = False
- RetryFile:
- Try
- File.Delete(FilePath)
- DeletedCount += 1
- Catch ex As DirectoryNotFoundException
- Return DeletedCount
- Catch ex As Exception
- If Not RetriedFile Then
- RetriedFile = True
- Log(ex, $"删除文件失败,将在 0.3s 后重试({FilePath})")
- Thread.Sleep(300)
- GoTo RetryFile
- ElseIf IgnoreIssue Then
- Log(ex, "删除单个文件可忽略地失败")
- Else
- Throw
- End If
- End Try
- Next
- For Each str As String In Directory.GetDirectories(Folder)
- DeleteDirectory(str, IgnoreIssue)
- Next
- Dim RetriedDir As Boolean = False
- RetryDir:
- Try
- Directory.Delete(Folder, True)
- Catch ex As DirectoryNotFoundException
- Catch ex As Exception
- If Not RetriedDir AndAlso Not RunInUi() Then
- RetriedDir = True
- Log(ex, $"删除文件夹失败,将在 0.3s 后重试({Folder})")
- Thread.Sleep(300)
- GoTo RetryDir
- ElseIf IgnoreIssue Then
- Log(ex, "删除单个文件夹可忽略地失败")
- Else
- Throw
- End If
- End Try
- Return DeletedCount
- End Function
- ''' <summary>
- ''' 复制文件夹,失败会抛出异常。
- ''' </summary>
- Public Sub CopyDirectory(FromPath As String, ToPath As String, Optional ProgressIncrementHandler As Action(Of Double) = Nothing)
- FromPath = FromPath.Replace("/", "\")
- If Not FromPath.EndsWithF("\") Then FromPath &= "\"
- ToPath = ToPath.Replace("/", "\")
- If Not ToPath.EndsWithF("\") Then ToPath &= "\"
- Dim AllFiles = EnumerateFiles(FromPath).ToList
- Dim FileCount As Long = AllFiles.Count
- For Each File In AllFiles
- CopyFile(File.FullName, File.FullName.Replace(FromPath, ToPath))
- If ProgressIncrementHandler IsNot Nothing AndAlso FileCount > 0 Then ProgressIncrementHandler(1 / FileCount)
- Next
- End Sub
- ''' <summary>
- ''' 遍历文件夹中的所有文件。
- ''' </summary>
- Public Function EnumerateFiles(Directory As String) As IEnumerable(Of FileInfo)
- Dim Info As New DirectoryInfo(Directory)
- If Not Info.Exists Then Return New List(Of FileInfo)
- Return Info.EnumerateFiles("*", SearchOption.AllDirectories)
- End Function
- #End Region
- #Region "文本"
- Public vbLQ As Char = Convert.ToChar(8220)
- Public vbRQ As Char = Convert.ToChar(8221)
- ''' <summary>
- ''' 提取 Exception 与 Inner Exception 的详细描述与堆栈信息。返回内容总是多于一行。
- ''' </summary>
- ''' <param name="ShowAllStacks">是否必须显示所有堆栈。通常用于判定堆栈信息。</param>
- <Extension> Public Function GetDetail(Ex As Exception, Optional ShowAllStacks As Boolean = False) As String
- If Ex Is Nothing Then Return "无可用错误信息!"
- '获取最底层的异常
- Dim OuterEx As Exception = Ex
- Dim InnerEx As Exception = Ex
- Do Until InnerEx.InnerException Is Nothing
- InnerEx = InnerEx.InnerException
- Loop
- '获取各级错误的描述与堆栈信息
- Dim DescList As New List(Of String)
- Dim IsInner As Boolean = False
- Do Until Ex Is Nothing
- DescList.Add(If(IsInner, "→ ", "") & Ex.Message.ReplaceLineEndings(vbCrLf, mergeMultiple:=True))
- If Ex.StackTrace IsNot Nothing Then
- For Each Stack As String In Ex.StackTrace.Split(vbCrLf.ToCharArray, StringSplitOptions.RemoveEmptyEntries)
- If ShowAllStacks OrElse Stack.ContainsIgnoreCase("pcl") Then
- DescList.Add(Stack.ReplaceLineEndings(""))
- End If
- Next
- End If
- If Ex.GetType.FullName <> "System.Exception" Then DescList.Add(" 错误类型:" & Ex.GetType.FullName)
- Ex = Ex.InnerException
- IsInner = True
- Loop
- '构造输出信息
- Dim UsualReason As String = AnalyzeUsualReason(InnerEx, OuterEx, DescList)
- If UsualReason Is Nothing Then
- Return DescList.Join(vbCrLf)
- Else
- Return UsualReason & vbCrLf & vbCrLf & "————————————" & vbCrLf & "详细错误信息:" & vbCrLf & DescList.Join(vbCrLf)
- End If
- End Function
- ''' <summary>
- ''' 提取 Exception 与 Inner Exception 的描述,汇总到一行。
- ''' </summary>
- <Extension> Public Function GetBrief(Ex As Exception) As String
- If Ex Is Nothing Then Return "无可用错误信息!"
- '获取最底层的异常
- Dim OuterEx As Exception = Ex
- Dim InnerEx As Exception = Ex
- Do Until InnerEx.InnerException Is Nothing
- InnerEx = InnerEx.InnerException
- Loop
- '获取各级错误的描述
- Dim DescList As New List(Of String)
- Do Until Ex Is Nothing
- DescList.Add(Ex.Message.ReplaceLineEndings(" ", mergeMultiple:=True))
- Ex = Ex.InnerException
- Loop
- DescList = DescList.Distinct.ToList
- Dim Desc As String = DescList.Join(vbCrLf & "→ ")
- '构造输出信息
- Dim UsualReason As String = AnalyzeUsualReason(InnerEx, OuterEx, DescList)
- If UsualReason IsNot Nothing Then
- Return UsualReason & "详细错误:" & DescList.First
- Else
- DescList.Reverse() '让最深层错误在最左边
- Return DescList.Join(" ← ")
- End If
- End Function
- Private Function AnalyzeUsualReason(InnerEx As Exception, OuterEx As Exception, DescList As List(Of String)) As String
- If TypeOf InnerEx Is TypeLoadException OrElse TypeOf InnerEx Is BadImageFormatException OrElse TypeOf InnerEx Is MissingMethodException OrElse TypeOf InnerEx Is NotImplementedException OrElse TypeOf InnerEx Is TypeInitializationException Then
- Return "PCL 的运行环境存在问题。请尝试重新安装 .NET Framework 4.6.2 然后再试。若无法安装,请先卸载较新版本的 .NET Framework,然后再尝试安装。"
- ElseIf TypeOf InnerEx Is UnauthorizedAccessException Then
- Return "PCL 的权限不足。请尝试右键 PCL 选择以管理员身份运行。"
- ElseIf TypeOf InnerEx Is OutOfMemoryException Then
- Return "你的电脑运行内存不足,导致 PCL 无法继续运行。请在关闭一部分不需要的程序后再试。"
- ElseIf TypeOf InnerEx Is Runtime.InteropServices.COMException Then
- Return "由于操作系统或显卡存在问题,导致出现错误。请尝试重启 PCL。"
- ElseIf TypeOf InnerEx Is SocketException AndAlso DescList.Any(Function(l) l.Contains("WSAStartup")) Then
- Return "请尝试卸载中国移动云盘,然后再试。"
- ElseIf OuterEx.IsNetworkRelated() Then
- Return "你的网络环境不佳,请稍后再试,或使用 VPN 改善网络环境。"
- Else
- Return Nothing
- End If
- End Function
- ''' <summary>
- ''' 返回一个枚举对应的字符串。
- ''' </summary>
- ''' <param name="EnumData">一个已经实例化的枚举类型。</param>
- Public Function GetStringFromEnum(EnumData As [Enum]) As String
- Return [Enum].GetName(EnumData.GetType, EnumData)
- End Function
- ''' <summary>
- ''' 将对象转换为枚举类型,支持数字或原文两种格式,若为空字符串或 Nothing 则返回 0。
- ''' 若转换失败会抛出异常。
- ''' </summary>
- <Extension> Public Function ToEnum(Of T As Structure)(Value As Object) As T
- If IsNumeric(Value) Then
- Return CType(CInt(Value), Object)
- ElseIf String.IsNullOrEmpty(Value?.ToString) Then
- Return CType(0, Object)
- Else
- Return [Enum].Parse(GetType(T), Value.ToString(), True)
- End If
- End Function
- ''' <summary>
- ''' 将文件大小转化为适合的文本形式,如“1.28 M”。
- ''' </summary>
- ''' <param name="FileSize">以字节为单位的大小表示。</param>
- Public Function FormatFileSize(FileSize As Long) As String
- Dim IsNegative = FileSize < 0
- If IsNegative Then FileSize *= -1
- If FileSize < 1000 Then
- 'B 级
- Return If(IsNegative, "-", "") & FileSize & " B"
- ElseIf FileSize < 1024 * 1000 Then
- 'K 级
- Dim RoundResult As String = Math.Round(FileSize / 1024)
- Return If(IsNegative, "-", "") & Math.Round(FileSize / 1024, CInt((3 - RoundResult.Length).Clamp(0, 2))) & " K"
- ElseIf FileSize < 1024 * 1024 * 1000 Then
- 'M 级
- Dim RoundResult As String = Math.Round(FileSize / 1024 / 1024)
- Return If(IsNegative, "-", "") & Math.Round(FileSize / 1024 / 1024, CInt((3 - RoundResult.Length).Clamp(0, 2))) & " M"
- Else
- 'G 级
- Dim RoundResult As String = Math.Round(FileSize / 1024 / 1024 / 1024)
- Return If(IsNegative, "-", "") & Math.Round(FileSize / 1024 / 1024 / 1024, CInt((3 - RoundResult.Length).Clamp(0, 2))) & " G"
- End If
- End Function
- ''' <summary>
- ''' 获取 JSON 对象。
- ''' </summary>
- Public Function GetJson(Data As String) As JToken
- Try
- Return JsonConvert.DeserializeObject(Data, New JsonSerializerSettings With {.DateTimeZoneHandling = DateTimeZoneHandling.Local})
- Catch ex As Exception
- Dim Length As Integer = If(Data, "").Length
- Throw New Exception("格式化 JSON 失败:" & If(Length > 2000, Data.Substring(0, 500) & $"...(全长 {Length} 个字符)..." & Right(Data, 500), Data), ex)
- End Try
- End Function
- ''' <summary>
- ''' 获取字符串哈希值。
- ''' </summary>
- Public Function GetHash(Str As String) As ULong
- Dim Result As ULong = 5381
- For Each v In Str
- Result = (Result << 5) Xor Result Xor CType(AscW(v), ULong)
- Next
- Return Result Xor &HA98F501BC684032FUL
- End Function
- ''' <summary>
- ''' 获取字符串 MD5。
- ''' </summary>
- Public Function GetStringMD5(Str As String) As String
- Using h = MD5Cng.Create()
- Dim hashedDataBytes = h.ComputeHash(Encoding.UTF8.GetBytes(Str))
- Dim tmp As New StringBuilder(hashedDataBytes.Length * 2)
- For Each i As Byte In hashedDataBytes
- tmp.Append(i.ToString("x2"))
- Next
- Return tmp.ToString()
- End Using
- End Function
- ''' <summary>
- ''' 不会报错的 Val。
- ''' 如果输入有误,返回 0。
- ''' </summary>
- Public Function Val(Str As Object) As Double
- If Str Is Nothing Then Return 0
- Try
- Return If(TypeOf Str Is String AndAlso Str = "&", 0, Conversion.Val(Str))
- Catch
- Return 0
- End Try
- End Function
- '正则
- ''' <summary>
- ''' 搜索字符串中的所有正则匹配项。
- ''' </summary>
- <Extension> Public Function RegexSearch(str As String, pattern As String, Optional options As RegexOptions = RegexOptions.None) As List(Of String)
- Try
- RegexSearch = New List(Of String)
- Dim RegexSearchRes = New Regex(pattern, options).Matches(str)
- If RegexSearchRes Is Nothing Then Return RegexSearch
- For Each item As Match In RegexSearchRes
- RegexSearch.Add(item.Value)
- Next
- Catch ex As Exception
- Log(ex, "正则匹配全部项出错")
- Return New List(Of String)
- End Try
- End Function
- ''' <summary>
- ''' 获取字符串中的第一个正则匹配项,若无匹配则返回 Nothing。
- ''' </summary>
- <Extension> Public Function RegexSeek(str As String, pattern As String, Optional options As RegexOptions = RegexOptions.None) As String
- Try
- Dim Result = Regex.Match(str, pattern, options).Value
- Return If(Result = "", Nothing, Result)
- Catch ex As Exception
- Log(ex, "正则匹配第一项出错")
- Return Nothing
- End Try
- End Function
- ''' <summary>
- ''' 检查字符串是否匹配某正则模式。
- ''' </summary>
- <Extension> Public Function RegexCheck(str As String, pattern As String, Optional options As RegexOptions = RegexOptions.None) As Boolean
- Try
- Return Regex.IsMatch(str, pattern, options)
- Catch ex As Exception
- Log(ex, "正则检查出错")
- Return False
- End Try
- End Function
- ''' <summary>
- ''' 进行正则替换。失败时会抛出异常。
- ''' </summary>
- <Extension> Public Function RegexReplace(AllContents As String, SearchRegex As String, ReplaceTo As String, Optional options As RegexOptions = RegexOptions.None) As String
- Return Regex.Replace(AllContents, SearchRegex, ReplaceTo, options)
- End Function
- ''' <summary>
- ''' 对每个正则匹配分别进行替换。失败时会抛出异常。
- ''' </summary>
- <Extension> Public Function RegexReplace(AllContents As String, SearchRegex As String, ReplaceTo As MatchEvaluator, Optional options As RegexOptions = RegexOptions.None) As String
- Return Regex.Replace(AllContents, SearchRegex, ReplaceTo, options)
- End Function
- #End Region
- #Region "搜索"
- ''' <summary>
- ''' 获取搜索文本的相似度。
- ''' </summary>
- ''' <param name="Source">被搜索的长内容。</param>
- ''' <param name="Query">用户输入的搜索文本。</param>
- Private Function SearchSimilarity(Source As String, Query As String) As Double
- If String.IsNullOrEmpty(Source) OrElse String.IsNullOrEmpty(Query) Then Return 0
- Dim qp As Integer = 0, lenSum As Double = 0
- Dim str As New StringBuilder(Source.Length)
- str.Append(Source.Lower().Replace(" ", ""))
- Query = Query.Lower().Replace(" ", "")
- Dim sourceLength As Integer = str.Length, queryLength As Integer = Query.Length '用于计算最后因数的长度缓存
- If queryLength = 0 Then Return 0
- Do While qp < queryLength
- '对 qp 作为开始位置计算
- Dim sp As Integer = 0, lenMax As Integer = 0, spMax As Integer = 0
- Dim currentSourceLength As Integer = str.Length
- Do While sp < currentSourceLength
- Dim len As Integer = 0
- While (qp + len) < queryLength AndAlso (sp + len) < currentSourceLength AndAlso str(sp + len) = Query(qp + len)
- len += 1
- End While
- '存储 len
- If len > lenMax Then
- lenMax = len
- spMax = sp
- End If
- '根据结果增加 sp
- sp += If(len > 0, len, 1)
- Loop
- If lenMax > 0 Then
- str.Remove(spMax, lenMax) '将源中的对应字段移除
- '存储 lenSum
- Dim IncWeight = (Math.Pow(1.4, 3 + lenMax) - 3.6) '根据长度加成
- IncWeight *= 1 + 0.3 * Math.Max(0, 3 - Math.Abs(qp - spMax)) '根据位置加成
- lenSum += IncWeight
- End If
- qp += If(lenMax > 0, lenMax, 1)
- Loop
- '计算结果:重复字段量 × 源长度影响比例
- Return (lenSum / queryLength) * (3 / Math.Sqrt(sourceLength + 15)) * If(queryLength <= 2, 3 - queryLength, 1)
- End Function
- ''' <summary>
- ''' 获取多段文本加权后的相似度。
- ''' </summary>
- Private Function SearchSimilarityWeighted(Source As List(Of SearchSource), Query As String) As Double
- Dim TotalWeight As Double = 0
- Dim Sum As Double = 0
- For Each Pair In Source
- If Pair.Aliases.Any Then
- Sum += Pair.Aliases.Max(Function(a) SearchSimilarity(a, Query)) * Pair.Weight
- End If
- TotalWeight += Pair.Weight
- Next
- Return Sum / TotalWeight
- End Function
- ''' <summary>
- ''' 用于搜索的项目。
- ''' </summary>
- Public Class SearchEntry(Of T)
- ''' <summary>
- ''' 该项目对应的源数据。
- ''' </summary>
- Public Item As T
- ''' <summary>
- ''' 该项目用于搜索的文本源。
- ''' 在搜索时,会对每个文本源单独加权,但单个文本源内的多个别名只取最高的一个的相似度。
- ''' </summary>
- Public SearchSource As List(Of SearchSource)
- ''' <summary>
- ''' 相似度。
- ''' </summary>
- Public Similarity As Double
- ''' <summary>
- ''' 是否完全匹配。
- ''' </summary>
- Public AbsoluteRight As Boolean
- Public Overrides Function ToString() As String
- Return Math.Round(Similarity, 3) & " - " & Item.ToString()
- End Function
- End Class
- ''' <summary>
- ''' 单个用于搜索的文本源。
- ''' </summary>
- Public Class SearchSource
- Public Aliases As String()
- Public Weight As Double
- Public Sub New(Aliases As String(), Optional Weight As Double = 1)
- Me.Aliases = Aliases
- Me.Weight = Weight
- End Sub
- Public Sub New(Text As String, Optional Weight As Double = 1)
- Me.Aliases = {Text}
- Me.Weight = Weight
- End Sub
- End Class
- ''' <summary>
- ''' 进行多段文本加权搜索,获取相似度较高的数项结果。
- ''' 在搜索时,会对每个文本源单独加权,但单个文本源内的多个别名只取最高的一个的相似度。
- ''' 这会修改 Entries 中每项的 Similarity 与 AbsoluteRight 字段。
- ''' </summary>
- ''' <param name="MaxBlurCount">返回的最大模糊结果数。</param>
- ''' <param name="MinBlurSimilarity">返回结果要求的最低相似度。</param>
- Public Function Search(Of T)(Entries As List(Of SearchEntry(Of T)), Query As String, Optional MaxBlurCount As Integer = 5, Optional MinBlurSimilarity As Double = 0.1) As List(Of SearchEntry(Of T))
- '初始化
- Dim ResultList As New List(Of SearchEntry(Of T))
- If Not Entries.Any() Then Return ResultList
- '进行搜索,获取相似信息
- Dim QueryParts = Query.Split({" "c}, StringSplitOptions.RemoveEmptyEntries)
- Dim Candidates As New List(Of SearchEntry(Of T))
- For Each Entry In Entries
- Entry.Similarity = SearchSimilarityWeighted(Entry.SearchSource, Query)
- Entry.AbsoluteRight =
- QueryParts.All( '对于按空格分割的每一段
- Function(QueryPart) Entry.SearchSource.Any( '若与任意一个搜索源完全匹配,则标记为完全匹配项
- Function(Source) Source.Aliases.Any(
- Function([Alias]) [Alias].Replace(" ", "").ContainsIgnoreCase(QueryPart))))
- If Entry.AbsoluteRight OrElse Entry.Similarity >= MinBlurSimilarity Then Candidates.Add(Entry)
- Next
- '按照相似度进行排序
- Candidates = Candidates.SortByComparison(Function(Left, Right) If(Left.AbsoluteRight <> Right.AbsoluteRight, Left.AbsoluteRight, Left.Similarity > Right.Similarity))
- '返回结果
- Dim BlurCount As Integer = 0
- For Each Entry In Candidates
- If Entry.AbsoluteRight Then
- ResultList.Add(Entry) '完全匹配,直接加入
- Else
- If BlurCount = MaxBlurCount Then Exit For
- ResultList.Add(Entry)
- BlurCount += 1 '模糊结果计数
- End If
- Next
- Return ResultList
- End Function
- #End Region
- #Region "系统"
- ''' <summary>
- ''' 为 Task 设置超时,在超时时抛出 TimeoutException。
- ''' </summary>
- <Extension> Public Function GetResultWithTimeout(Of T)(TargetTask As Task(Of T), TokenSource As CancellationTokenSource, TimeoutMs As Integer) As T
- Dim DelayTask = Task.Delay(TimeoutMs)
- If Task.WhenAny(TargetTask, DelayTask).ConfigureAwait(False).GetAwaiter().GetResult() Is DelayTask Then
- TokenSource.Cancel()
- Throw New TimeoutException($"任务超时({TimeoutMs} ms)")
- End If
- Return TargetTask.GetAwaiter().GetResult()
- End Function
- ''' <summary>
- ''' 为 Task 设置超时,在超时时抛出 TimeoutException。
- ''' </summary>
- <Extension> Public Sub GetResultWithTimeout(TargetTask As Task, TokenSource As CancellationTokenSource, TimeoutMs As Integer)
- Dim DelayTask = Task.Delay(TimeoutMs)
- If Task.WhenAny(TargetTask, DelayTask).ConfigureAwait(False).GetAwaiter().GetResult() Is DelayTask Then
- TokenSource.Cancel()
- Throw New TimeoutException($"任务超时({TimeoutMs} ms)")
- End If
- TargetTask.GetAwaiter().GetResult()
- End Sub
- ''' <summary>
- ''' 可用于临时存放文件的,不含任何特殊字符的文件夹路径,以“\”结尾。
- ''' </summary>
- Public PathPure As String = GetPureASCIIDir()
- Private Function GetPureASCIIDir() As String
- If (PathExeFolder & "PCL").IsAsciiOnly() Then
- Return PathExeFolder & "PCL\"
- ElseIf PathAppdata.IsAsciiOnly() Then
- Return PathAppdata
- ElseIf PathTemp.IsAsciiOnly() Then
- Return PathTemp
- Else
- Return OsDrive & "ProgramData\PCL\"
- End If
- End Function
- ''' <summary>
- ''' 指示接取到这个异常的函数进行重试。
- ''' </summary>
- Public Class RestartException
- Inherits Exception
- End Class
- ''' <summary>
- ''' 指示用户手动取消了操作,或用户已知晓操作被取消的原因。
- ''' </summary>
- Public Class CancelledException
- Inherits Exception
- End Class
- ''' <summary>
- ''' 当前程序是否拥有管理员权限。
- ''' </summary>
- Public Function IsAdmin() As Boolean
- Dim id As WindowsIdentity = WindowsIdentity.GetCurrent()
- Dim principal As New WindowsPrincipal(id)
- Return principal.IsInRole(WindowsBuiltInRole.Administrator)
- End Function
- ''' <summary>
- ''' 以管理员权限运行当前程序,并等待程序运行结束。
- ''' 返回程序的返回代码,如果运行失败将抛出异常。
- ''' </summary>
- Public Function RunAsAdmin(Argument As String) As Integer
- Dim NewProcess = StartProcess(New ProcessStartInfo(PathExe) With {.Verb = "runas", .Arguments = Argument})
- NewProcess.WaitForExit()
- Return NewProcess.ExitCode
- End Function
- ''' <summary>
- ''' 判断当前系统语言是否为中文。
- ''' </summary>
- Public Function IsSystemLanguageChinese() As Boolean
- Return CultureInfo.CurrentCulture.Name.StartsWithF("zh-") OrElse CultureInfo.CurrentUICulture.Name.StartsWithF("zh-")
- End Function
- ''' <summary>
- ''' 判断对象是否为某个泛型类型的实例。
- ''' </summary>
- <Extension> Public Function IsInstanceOfGenericType(genericType As Type, obj As Object) As Boolean
- If obj Is Nothing Then Return False
- Dim t = obj.GetType()
- While t IsNot Nothing
- If t.IsGenericType AndAlso t.GetGenericTypeDefinition() Is genericType Then Return True
- t = t.BaseType
- End While
- Return False
- End Function
- Private Uuid As Integer = 1
- Private UuidLock As Object
- ''' <summary>
- ''' 获取一个全程序内不会重复的数字(伪 Uuid)。
- ''' </summary>
- Public Function GetUuid() As Integer
- If UuidLock Is Nothing Then UuidLock = New Object
- SyncLock UuidLock
- Uuid += 1
- Return Uuid
- End SyncLock
- End Function
- ''' <summary>
- ''' 获取格式类似于“11:08:52.037”的当前时间的字符串。
- ''' </summary>
- Public Function GetTimeNow() As String
- Return Date.Now.ToString("HH':'mm':'ss'.'fff")
- End Function
- ''' <summary>
- ''' 获取一个单调递增时间值(毫秒)。
- ''' </summary>
- Public Function GetTimeMs() As Long
- Return Stopwatch.GetTimestamp() \ (Stopwatch.Frequency \ 1000L)
- End Function
- ''' <summary>
- ''' 将时间间隔转换为类似“5 分 10 秒前”的易于阅读的形式。
- ''' </summary>
- Public Function GetTimeSpanString(Span As TimeSpan, IsShortForm As Boolean) As String
- Dim EndFix = If(Span.TotalMilliseconds > 0, "后", "前")
- If Span.TotalMilliseconds < 0 Then Span = -Span
- Dim TotalMonthes = Math.Floor(Span.Days / 30)
- If IsShortForm Then
- If TotalMonthes >= 12 Then
- '1+ 年,“3 年”
- GetTimeSpanString = Math.Floor(TotalMonthes / 12) & " 年"
- ElseIf TotalMonthes >= 2 Then
- '2~11 月,“5 个月”
- GetTimeSpanString = TotalMonthes & " 个月"
- ElseIf Span.TotalDays >= 2 Then
- '2 天 ~ 2 月,“23 天”
- GetTimeSpanString = Span.Days & " 天"
- ElseIf Span.TotalHours >= 1 Then
- '1 小时 ~ 2 天,“15 小时”
- GetTimeSpanString = Span.Hours & " 小时"
- ElseIf Span.TotalMinutes >= 1 Then
- '1 分钟 ~ 1 小时,“49 分钟”
- GetTimeSpanString = Span.Minutes & " 分钟"
- ElseIf Span.TotalSeconds >= 1 Then
- '1 秒 ~ 1 分钟,“23 秒”
- GetTimeSpanString = Span.Seconds & " 秒"
- Else
- '不到 1 秒
- GetTimeSpanString = "1 秒"
- End If
- Else
- If TotalMonthes >= 61 Then
- '5+ 年,“5 年”
- GetTimeSpanString = Math.Floor(TotalMonthes / 12) & " 年"
- ElseIf TotalMonthes >= 12 Then
- '12~60 月,“1 年 2 个月”
- GetTimeSpanString = Math.Floor(TotalMonthes / 12) & " 年" & If((TotalMonthes Mod 12) > 0, " " & (TotalMonthes Mod 12) & " 个月", "")
- ElseIf TotalMonthes >= 4 Then
- '4~11 月,“5 个月”
- GetTimeSpanString = TotalMonthes & " 个月"
- ElseIf TotalMonthes >= 1 Then
- '1~4 月,“2 个月 13 天”
- GetTimeSpanString = TotalMonthes & " 月" & If((Span.Days Mod 30) > 0, " " & (Span.Days Mod 30) & " 天", "")
- ElseIf Span.TotalDays >= 4 Then
- '4~30 天,“23 天”
- GetTimeSpanString = Span.Days & " 天"
- ElseIf Span.TotalDays >= 1 Then
- '1~3 天,“2 天 20 小时”
- GetTimeSpanString = Span.Days & " 天" & If(Span.Hours > 0, " " & Span.Hours & " 小时", "")
- ElseIf Span.TotalHours >= 10 Then
- '10 小时 ~ 1 天,“15 小时”
- GetTimeSpanString = Span.Hours & " 小时"
- ElseIf Span.TotalHours >= 1 Then
- '1~10 小时,“1 小时 20 分钟”
- GetTimeSpanString = Span.Hours & " 小时" & If(Span.Minutes > 0, " " & Span.Minutes & " 分钟", "")
- ElseIf Span.TotalMinutes >= 10 Then
- '10 分钟 ~ 1 小时,“49 分钟”
- GetTimeSpanString = Span.Minutes & " 分钟"
- ElseIf Span.TotalMinutes >= 1 Then
- '1~10 分钟,“9 分 23 秒”
- GetTimeSpanString = Span.Minutes & " 分" & If(Span.Seconds > 0, " " & Span.Seconds & " 秒", "")
- ElseIf Span.TotalSeconds >= 1 Then
- '1 秒 ~ 1 分钟,“23 秒”
- GetTimeSpanString = Span.Seconds & " 秒"
- Else
- '不到 1 秒
- GetTimeSpanString = "1 秒"
- End If
- End If
- GetTimeSpanString += EndFix
- End Function
- ''' <summary>
- ''' 获取十进制 Unix 时间戳。
- ''' </summary>
- Public Function GetUnixTimestamp() As Long
- Return (Now.ToUniversalTime().Ticks - 621355968000000000) / 10000000
- End Function
- ''' <summary>
- ''' 用于储存 RaiseByMouse 的 EventArgs。
- ''' </summary>
- Public NotInheritable Class RouteEventArgs
- Inherits EventArgs
- Public RaiseByMouse As Boolean
- Public Handled As Boolean = False
- Public Sub New(Optional RaiseByMouse As Boolean = False)
- Me.RaiseByMouse = RaiseByMouse
- End Sub
- End Class
- ''' <summary>
- ''' 启动进程并返回进程实例,若失败则抛出异常。
- ''' 会自动进行长路径处理。
- ''' </summary>
- Public Function StartProcess(FileName As String, Optional Arguments As String = "") As Process
- Return StartProcess(New ProcessStartInfo With {.FileName = FileName, .Arguments = Arguments})
- End Function
- ''' <summary>
- ''' 启动进程并返回进程实例,若失败则抛出异常。
- ''' 会自动进行长路径处理。
- ''' </summary>
- Public Function StartProcess(StartInfo As ProcessStartInfo) As Process
- StartInfo.FileName = FileUtils.ShortenPath(StartInfo.FileName)
- If Not String.IsNullOrEmpty(StartInfo.WorkingDirectory) Then StartInfo.WorkingDirectory = FileUtils.ShortenPath(StartInfo.WorkingDirectory)
- Log("[System] 启动进程:" & StartInfo.FileName & " " & StartInfo.Arguments)
- Return Process.Start(StartInfo)
- End Function
- ''' <summary>
- ''' 静默运行文件并返回输出流字符串。执行失败会抛出异常。
- ''' </summary>
- ''' <param name="FileName">文件名。可以为“notepad”等缩写。</param>
- ''' <param name="Arguments">运行参数。</param>
- ''' <param name="Timeout">等待该程序结束的最长时间(毫秒)。超时会抛出错误。</param>
- Public Function StartProcessAndGetOutput(FileName As String, Optional Arguments As String = "", Optional Timeout As Integer = 1000000,
- Optional WorkingDirectory As String = Nothing, Optional Encoding As Encoding = Nothing, Optional PrintLog As Boolean = True) As String
- Dim Info = New ProcessStartInfo With {
- .Arguments = Arguments,
- .FileName = FileUtils.ShortenPath(FileName),
- .UseShellExecute = False,
- .CreateNoWindow = True,
- .RedirectStandardError = True,
- .RedirectStandardOutput = True,
- .WorkingDirectory = FileUtils.ShortenPath(If(WorkingDirectory, PathExeFolder.TrimEnd("\"c))),
- .StandardErrorEncoding = Encoding,
- .StandardOutputEncoding = Encoding
- }
- If WorkingDirectory IsNot Nothing Then
- If Info.EnvironmentVariables.ContainsKey("appdata") Then
- Info.EnvironmentVariables("appdata") = WorkingDirectory
- Else
- Info.EnvironmentVariables.Add("appdata", WorkingDirectory)
- End If
- End If
- If PrintLog Then Log("[System] 执行命令并等待返回结果:" & FileName & " " & Arguments)
- Using Program As New Process With {.StartInfo = Info}
- Program.Start()
- Dim Result As String = Program.StandardOutput.ReadToEnd & Program.StandardError.ReadToEnd
- Program.WaitForExit(Timeout)
- If Not Program.HasExited Then Program.Kill()
- Return Result
- End Using
- End Function
- ''' <summary>
- ''' 在新的工作线程中执行代码。
- ''' </summary>
- Public Function RunInNewThread(Action As Action, Optional Name As String = Nothing, Optional Priority As ThreadPriority = ThreadPriority.Normal) As Thread
- Dim th As New Thread(
- Sub()
- Try
- Action()
- Catch ex As ThreadInterruptedException
- Log(Name & ":线程已中止")
- Catch ex As Exception
- Log(ex, Name & ":线程执行失败", NotifyLevel.MsgBoxAndFeedback)
- End Try
- End Sub) With {.Name = If(Name, "Runtime New Invoke " & GetUuid() & "#"), .Priority = Priority}
- th.Start()
- Return th
- End Function
- ''' <summary>
- ''' 确保在 UI 线程中执行代码。
- ''' 如果当前并非 UI 线程,则会阻断当前线程,直至 UI 线程执行完毕。
- ''' 为防止线程互锁,请仅在开始加载动画、从 UI 获取输入时使用!
- ''' </summary>
- Public Function RunInUiWait(Of Output)(Action As Func(Of Output)) As Output
- If RunInUi() Then
- Return Action()
- Else
- Return Application.Current.Dispatcher.Invoke(Action)
- End If
- End Function
- ''' <summary>
- ''' 确保在 UI 线程中执行代码。
- ''' 如果当前并非 UI 线程,则会阻断当前线程,直至 UI 线程执行完毕。
- ''' 为防止线程互锁,请仅在开始加载动画、从 UI 获取输入时使用!
- ''' </summary>
- Public Sub RunInUiWait(Action As Action)
- If RunInUi() Then
- Action()
- Else
- Application.Current.Dispatcher.Invoke(Action)
- End If
- End Sub
- ''' <summary>
- ''' 确保在 UI 线程中执行代码,代码按触发顺序执行。
- ''' 如果当前并非 UI 线程,也不阻断当前线程的执行。
- ''' </summary>
- Public Sub RunInUi(Action As Action, Optional ForceWaitUntilLoaded As Boolean = False)
- If ForceWaitUntilLoaded Then
- Application.Current.Dispatcher.InvokeAsync(Action, Threading.DispatcherPriority.Loaded)
- ElseIf RunInUi() Then
- Action()
- Else
- Application.Current.Dispatcher.InvokeAsync(Action)
- End If
- End Sub
- ''' <summary>
- ''' 确保在工作线程中执行代码。
- ''' </summary>
- Public Sub RunInThread(Action As Action)
- If RunInUi() Then
- RunInNewThread(Action, "Invoke " & GetUuid())
- Else
- Action()
- End If
- End Sub
- ''' <summary>
- ''' 按照既定的函数进行选择排序。
- ''' 返回第一个对象是否应该排在前面(a > b)。
- ''' </summary>
- <Extension> Public Function SortByComparison(Of T)(List As IList(Of T), SortRule As Func(Of T, T, Boolean)) As List(Of T)
- Dim NewList As New List(Of T)
- While List.Any
- Dim Highest = List(0)
- For i = 1 To List.Count - 1
- If SortRule(List(i), Highest) Then Highest = List(i)
- Next
- List.Remove(Highest)
- NewList.Add(Highest)
- End While
- Return NewList
- End Function
- ''' <summary>
- ''' 获取程序启动参数。
- ''' </summary>
- ''' <param name="Name">参数名。</param>
- ''' <param name="DefaultValue">默认值。</param>
- Public Function GetProgramArgument(Name As String, Optional DefaultValue As Object = "")
- Dim AllArguments() As String = Command.Split(" ")
- For i = 0 To AllArguments.Length - 1
- If AllArguments(i) = "-" & Name Then
- If AllArguments.Length = i + 1 OrElse AllArguments(i + 1).StartsWithF("-") Then Return True
- Return AllArguments(i + 1)
- End If
- Next
- Return DefaultValue
- End Function
- ''' <summary>
- ''' 时间戳转化为日期。
- ''' </summary>
- Public Function GetDate(timeStamp As Integer) As Date
- Dim dtStart As Date = TimeZone.CurrentTimeZone.ToLocalTime(New Date(1970, 1, 1, 0, 0, 0, DateTimeKind.Utc))
- Dim lTime As Long = (CLng(timeStamp) * 10000000)
- Return dtStart.Add(New TimeSpan(lTime))
- End Function
- ''' <summary>
- ''' 将 UTC 时间转化为当前时区的时间。
- ''' </summary>
- Public Function GetLocalTime(UtcDate As Date) As Date
- Return DateTime.SpecifyKind(UtcDate, DateTimeKind.Utc).ToLocalTime
- End Function
- ''' <summary>
- ''' 打开网页。
- ''' </summary>
- Public Sub OpenWebsite(Url As String)
- Try
- If Not Url.StartsWithF("http", True) AndAlso Not Url.StartsWithF("minecraft://", True) AndAlso Not Url.StartsWithF("minecraft-preview://", True) Then
- Throw New Exception(Url & " 不是一个有效的网址,它必须以 http 开头!")
- End If
- Log("[System] 正在打开网页:" & Url)
- StartProcess(Url)
- Catch ex As Exception
- Log(ex, "无法打开网页(" & Url & ")")
- ClipboardSet(Url, False)
- MyMsgBox("可能由于浏览器未正确配置,PCL 无法为你打开网页。" & vbCrLf & "网址已经复制到剪贴板,若有需要可以手动粘贴访问。" & vbCrLf &
- $"网址:{Url}", "无法打开网页")
- End Try
- End Sub
- ''' <summary>
- ''' 打开 explorer。
- ''' 若不以 \ 结尾,则将视作文件路径,打开并选中此文件。
- ''' </summary>
- Public Sub OpenExplorer(Location As String)
- Try
- Location = Location.Replace("/", "\").Trim(" "c, """"c)
- Log("[System] 正在打开资源管理器:" & Location)
- If Location.EndsWithF("\") Then
- StartProcess(Location)
- Else
- StartProcess("explorer", $"/select,""{Location}""")
- End If
- Catch ex As Exception
- Log(ex, "打开资源管理器失败,请尝试关闭安全软件(如 360 安全卫士)", NotifyLevel.MsgBox)
- End Try
- End Sub
- ''' <summary>
- ''' 设置剪贴板。将在另一线程运行,且不会抛出异常。
- ''' </summary>
- Public Sub ClipboardSet(Text As String, Optional ShowSuccessHint As Boolean = True)
- RunInThread(
- Sub()
- Dim RetryCount As Integer = 0
- Retry:
- Try
- RunInUi(
- Sub()
- My.Computer.Clipboard.Clear()
- If Not String.IsNullOrEmpty(Text) Then My.Computer.Clipboard.SetText(Text)
- End Sub)
- Catch ex As Exception
- RetryCount += 1
- If RetryCount <= 5 Then
- Thread.Sleep(20)
- GoTo Retry
- Else
- Log(ex, "可能由于剪贴板被其他程序占用,文本复制失败", NotifyLevel.AllUsers)
- End If
- End Try
- If ShowSuccessHint Then Hint("已成功复制!", HintType.Green)
- End Sub)
- End Sub
- ''' <summary>
- ''' 获取剪贴板文本。将在 UI 线程运行,且不会抛出异常。
- ''' </summary>
- Public Function ClipboardGetText() As String
- Dim Result As String = Nothing
- RunInUiWait(
- Sub()
- Try
- If My.Computer.Clipboard.ContainsText() Then Result = My.Computer.Clipboard.GetText()
- Catch ex As Exception
- Log(ex, "获取剪贴板文本失败")
- End Try
- End Sub)
- Return Result
- End Function
- ''' <summary>
- ''' 以 Byte() 形式获取程序中的资源。
- ''' </summary>
- Public Function GetResources(ResourceName As String) As Byte()
- Log("[System] 获取资源:" & ResourceName)
- Return My.Resources.ResourceManager.GetObject(ResourceName)
- End Function
- #End Region
- #Region "UI"
- 'DPI 转换
- Public ReadOnly DPI As Integer = System.Drawing.Graphics.FromHwnd(IntPtr.Zero).DpiX
- ''' <summary>
- ''' 将经过 DPI 缩放的 WPF 尺寸转化为实际的像素尺寸。
- ''' </summary>
- Public Function GetPixelSize(WPFSize As Double) As Double
- Return WPFSize / 96 * DPI
- End Function
- ''' <summary>
- ''' 将实际的像素尺寸转化为经过 DPI 缩放的 WPF 尺寸。
- ''' </summary>
- Public Function GetWPFSize(PixelSize As Double) As Double
- Return PixelSize * 96 / DPI
- End Function
- ''' <summary>
- ''' 将 XML 转换为对应 UI 对象。
- ''' 注意:性能较差,不应大量使用。
- ''' </summary>
- Public Function GetObjectFromXML(Str As XElement)
- Return GetObjectFromXML(Str.ToString)
- End Function
- ''' <summary>
- ''' 将 XML 转换为对应 UI 对象。
- ''' 注意:性能较差,不应大量使用。
- ''' </summary>
- Public Function GetObjectFromXML(Str As String) As Object
- Str = Str. '兼容旧版自定义事件写法
- Replace("EventType=""", "local:CustomEventService.EventType=""").
- Replace("EventData=""", "local:CustomEventService.EventData=""").
- Replace("EventType='", "local:CustomEventService.EventType='").
- Replace("EventData='", "local:CustomEventService.EventData='").
- Replace("Property=""EventType""", "Property=""local:CustomEventService.EventType""").
- Replace("Property=""EventData""", "Property=""local:CustomEventService.EventData""").
- Replace("Property='EventType'", "Property='local:CustomEventService.EventType'").
- Replace("Property='EventData'", "Property='local:CustomEventService.EventData'")
- Using Stream As New MemoryStream(Encoding.UTF8.GetBytes(Str))
- '类型检查
- Using Reader As New XamlXmlReader(Stream)
- While Reader.Read()
- For Each BlackListType In {GetType(WebBrowser), GetType(Frame), GetType(MediaElement), GetType(ObjectDataProvider), GetType(XamlReader), GetType(Window), GetType(XmlDataProvider), GetType(SettingService)}
- If Reader.Type IsNot Nothing AndAlso BlackListType.IsAssignableFrom(Reader.Type.UnderlyingType) Then Throw New UnauthorizedAccessException($"基于安全考虑,不允许使用 {BlackListType.Name} 类型。")
- If Reader.Value IsNot Nothing AndAlso Reader.Value = BlackListType.Name Then Throw New UnauthorizedAccessException($"基于安全考虑,不允许使用 {BlackListType.Name} 值。")
- Next
- For Each BlackListMember In {"Code", "FactoryMethod", "Static"}
- If Reader.Member IsNot Nothing AndAlso Reader.Member.Name = BlackListMember Then Throw New UnauthorizedAccessException($"基于安全考虑,不允许使用 {BlackListMember} 成员。")
- Next
- End While
- End Using
- '实际的加载
- Stream.Position = 0
- Using Writer As New StreamWriter(Stream)
- Writer.Write(Str)
- Writer.Flush()
- Stream.Position = 0
- Return Markup.XamlReader.Load(Stream)
- End Using
- End Using
- End Function
- Private ReadOnly UiThreadId As Integer = Thread.CurrentThread.ManagedThreadId
- ''' <summary>
- ''' 当前线程是否为主线程。
- ''' </summary>
- Public Function RunInUi() As Boolean
- Return Thread.CurrentThread.ManagedThreadId = UiThreadId
- End Function
- ''' <summary>
- ''' 检查某个控件是否位于主窗口可视区域内,且控件本身可见。
- ''' </summary>
- <Extension> Public Function IsVisibleInForm(element As FrameworkElement) As Boolean
- If Not element.IsVisible Then Return False
- Dim bounds As Rect = element.TransformToAncestor(FrmMain).TransformBounds(New Rect(0, 0, element.ActualWidth, element.ActualHeight))
- Dim rect As New Rect(0, 0, FrmMain.ActualWidth, FrmMain.ActualHeight)
- Return rect.Contains(bounds.TopLeft) OrElse rect.Contains(bounds.BottomRight)
- End Function
- ''' <summary>
- ''' 控件是否受到 TextTrimming 属性影响,导致内容被截取。
- ''' </summary>
- <Extension> Public Function IsTextTrimmed(Control As TextBlock) As Boolean
- Control.Measure(New Size(Double.MaxValue, Double.MaxValue))
- Return Control.DesiredSize.Width > Control.ActualWidth
- End Function
- ''' <summary>
- ''' 获取文本在被渲染后的宽度。
- ''' </summary>
- Public Function MeasureStringWidth(text As String, Optional fontSize As Double = 14, Optional fontFamily As FontFamily = Nothing) As Double
- If fontFamily Is Nothing Then fontFamily = New FontFamily("微软雅黑")
- Dim formattedText = New FormattedText(
- text, CultureInfo.CurrentCulture, FlowDirection.LeftToRight, New Typeface(fontFamily, FontStyles.Normal, FontWeights.Normal, FontStretches.Normal),
- fontSize, Brushes.Black, New NumberSubstitution(), TextFormattingMode.Display, New DpiScale(1, 1).PixelsPerDip)
- Return formattedText.Width
- End Function
- ''' <summary>
- ''' 将布尔值转换为 Visibility。True 转换为 Visible,False 转换为 Collapsed。
- ''' </summary>
- <Extension> Public Function ToVisibility(IsVisible As Boolean) As Visibility
- Return If(IsVisible, Visibility.Visible, Visibility.Collapsed)
- End Function
- #End Region
- #Region "Debug"
- Public ReadOnly Property ModeDebug As Boolean
- Get
- Return Settings.Get("SystemDebugMode")
- End Get
- End Property
- 'Log
- Public Enum NotifyLevel
- ''' <summary>
- ''' 不提示,只记录日志。
- ''' </summary>
- Silent = 0
- ''' <summary>
- ''' 只在开发中版本弹出提示条。
- ''' </summary>
- DevelopOnly = 1
- ''' <summary>
- ''' 只在开发中版本或调试模式下弹出提示条。
- ''' </summary>
- DebugModeOnly = 2
- ''' <summary>
- ''' 对所有用户弹出提示条。
- ''' </summary>
- AllUsers = 3
- ''' <summary>
- ''' 弹出窗口,不要求提交反馈。
- ''' </summary>
- MsgBox = 4
- ''' <summary>
- ''' 弹出窗口,并要求提交反馈。
- ''' </summary>
- MsgBoxAndFeedback = 5
- ''' <summary>
- ''' 弹出 Windows 原生弹窗,并要求提交反馈。
- ''' 可在无法保证 UI 能正常运行时使用此级别。
- ''' </summary>
- Critical = 6
- End Enum
- Private LogList As New StringBuilder
- Private LogWritter As StreamWriter
- Public Sub LogStart()
- RunInNewThread(
- Sub()
- Dim IsInitSuccess As Boolean = True
- Try
- For i = 4 To 1 Step -1
- If File.Exists(PathExeFolder & "PCL\Log" & i & ".txt") Then
- If File.Exists(PathExeFolder & "PCL\Log" & (i + 1) & ".txt") Then File.Delete(PathExeFolder & "PCL\Log" & (i + 1) & ".txt")
- CopyFile(PathExeFolder & "PCL\Log" & i & ".txt", PathExeFolder & "PCL\Log" & (i + 1) & ".txt")
- End If
- Next
- File.Create(PathExeFolder & "PCL\Log1.txt").Dispose()
- Catch ex As IOException
- IsInitSuccess = False
- Hint("可能同时开启了多个 PCL,程序可能会出现未知问题!", HintType.Red)
- Log(ex, "日志初始化失败(疑似文件占用问题)")
- Catch ex As Exception
- IsInitSuccess = False
- Log(ex, "日志初始化失败", NotifyLevel.AllUsers)
- End Try
- Try
- LogWritter = New StreamWriter(PathExeFolder & "PCL\Log1.txt", True) With {.AutoFlush = True}
- Catch ex As Exception
- LogWritter = Nothing
- Log(ex, "日志写入失败", NotifyLevel.AllUsers)
- End Try
- While True
- If IsInitSuccess Then
- LogFlush()
- Else
- LogList = New StringBuilder '清空 LogList 避免内存爆炸
- End If
- Thread.Sleep(50)
- End While
- End Sub, "Log Writer", ThreadPriority.Lowest)
- End Sub
- Private ReadOnly LogFlushLock As New Object '防止外部调用 LogFlush 时同时输出多次日志
- Public Sub LogFlush()
- On Error Resume Next
- If LogWritter Is Nothing Then Return
- Dim Log As String = Nothing
- SyncLock LogFlushLock
- If LogList.Length > 0 Then
- Dim LogListCache As StringBuilder
- LogListCache = LogList
- LogList = New StringBuilder
- Log = LogListCache.ToString
- End If
- End SyncLock
- If Log IsNot Nothing Then
- LogWritter.Write(Log)
- End If
- End Sub
- Private ReadOnly LogListLock As New Object '防止日志乱码,只在调试模式下启用
- Private IsCriticalErrorTriggered As Boolean = False
- ''' <summary>
- ''' 输出 Log。
- ''' </summary>
- ''' <param name="Title">如果要求弹窗,指定弹窗的标题。</param>
- Public Sub Log(Text As String, Optional Level As NotifyLevel = NotifyLevel.Silent, Optional Title As String = "出现错误")
- On Error Resume Next
- '放在最后会导致无法显示极端错误下的弹窗(如无法写入日志文件)
- '处理错误会导致再次调用 Log() 导致无限循环
- '输出日志
- Dim AppendText As String = $"[{GetTimeNow()}] <{If(Thread.CurrentThread.Name = "", "主线程", Thread.CurrentThread.Name)}> {Text}{vbCrLf}" '减轻同步锁占用
- AppendText = FilterUserName(FilterAccessToken(AppendText, "*"), "*")
- If ModeDebug Then
- SyncLock LogListLock
- LogList.Append(AppendText)
- End SyncLock
- Else
- LogList.Append(AppendText)
- End If
- If BuildType = BuildTypes.Debug Then Console.Write(AppendText)
- If IsProgramEnded OrElse Level = NotifyLevel.Silent Then Return
- '去除前缀
- Text = Text.RegexReplace("\[[^\]]+?\] ", "")
- '输出提示
- Select Case Level
- Case NotifyLevel.DevelopOnly
- If BuildType = BuildTypes.Debug Then Hint("[开发者模式] " & Text, HintType.Blue, False)
- Case NotifyLevel.DebugModeOnly
- If BuildType = BuildTypes.Debug OrElse ModeDebug Then Hint("[调试模式] " & Text, HintType.Blue, False)
- Case NotifyLevel.AllUsers
- Hint(Text, HintType.Red, False)
- Case NotifyLevel.MsgBox
- MyMsgBox(Text, Title, IsWarn:=True)
- Case NotifyLevel.MsgBoxAndFeedback
- If CanFeedback(False) Then
- If MyMsgBox(Text & vbCrLf & vbCrLf & "是否反馈此问题?如果不反馈,这个问题可能永远无法得到解决!", Title, "反馈", "取消", IsWarn:=True) = 1 Then Feedback(False, True)
- Else
- MyMsgBox(Text & vbCrLf & vbCrLf & "将 PCL 更新至最新版或许可以解决这个问题……", Title, IsWarn:=True)
- End If
- Case NotifyLevel.Critical
- If IsCriticalErrorTriggered Then
- FormMain.EndProgramForce(ProcessReturnValues.Exception)
- Return
- End If
- IsCriticalErrorTriggered = True
- If CanFeedback(False) Then
- If MsgBox(Text & vbCrLf & vbCrLf & "是否反馈此问题?如果不反馈,这个问题可能永远无法得到解决!", MsgBoxStyle.Critical + MsgBoxStyle.YesNo, Title) = MsgBoxResult.Yes Then Feedback(False, True)
- Else
- MsgBox(Text & vbCrLf & vbCrLf & "将 PCL 更新至最新版或许可以解决这个问题……", MsgBoxStyle.Critical, Title)
- End If
- End Select
- '上报
- If Level >= NotifyLevel.AllUsers Then
- Telemetry("PCL 错误",
- "Level", GetStringFromEnum(Level),
- "Title", FilterUserName(FilterAccessToken(Title, "*"), "*"),
- "Exception", FilterUserName(FilterAccessToken(Text, "*"), "*"))
- End If
- End Sub
- ''' <summary>
- ''' 输出错误信息。
- ''' </summary>
- ''' <param name="Desc">错误描述。会在处理时在末尾加入冒号。</param>
- Public Sub Log(Ex As Exception, Desc As String, Optional Level As NotifyLevel = NotifyLevel.DebugModeOnly, Optional Title As String = "出现错误")
- On Error Resume Next
- If TypeOf Ex Is ThreadInterruptedException Then Return
- '获取错误信息
- Dim ExFull As String = $"{Desc}:{Ex.GetDetail()}"
- '输出日志
- Dim AppendText As String = $"[{GetTimeNow()}] <{If(Thread.CurrentThread.Name = "", "主线程", Thread.CurrentThread.Name)}> {Desc}:{Ex.GetDetail(True)}{vbCrLf}" '减轻同步锁占用
- AppendText = FilterUserName(FilterAccessToken(AppendText, "*"), "*")
- If ModeDebug Then
- SyncLock LogListLock
- LogList.Append(AppendText)
- End SyncLock
- Else
- LogList.Append(AppendText)
- End If
- If BuildType = BuildTypes.Debug Then Console.Write(AppendText)
- If IsProgramEnded Then Return
- '输出提示
- Select Case Level
- Case NotifyLevel.Silent
- Case NotifyLevel.DevelopOnly
- If BuildType = BuildTypes.Debug Then
- Dim ExLine As String = Desc & ":" & Ex.GetBrief()
- Hint("[开发者模式] " & ExLine, HintType.Blue, False)
- End If
- Case NotifyLevel.DebugModeOnly
- If BuildType = BuildTypes.Debug OrElse ModeDebug Then
- Dim ExLine As String = Desc & ":" & Ex.GetBrief()
- Hint("[调试模式] " & ExLine, HintType.Blue, False)
- End If
- Case NotifyLevel.AllUsers
- Dim ExLine As String = Desc & ":" & Ex.GetBrief()
- Hint(ExLine, HintType.Red, False)
- Case NotifyLevel.MsgBox
- MyMsgBox(ExFull, Title, IsWarn:=True)
- Case NotifyLevel.MsgBoxAndFeedback
- If CanFeedback(False) Then
- If MyMsgBox(ExFull & vbCrLf & vbCrLf & "是否反馈此问题?如果不反馈,这个问题可能永远无法得到解决!", Title, "反馈", "取消", IsWarn:=True) = 1 Then Feedback(False, True)
- Else
- MyMsgBox(ExFull & vbCrLf & vbCrLf & "将 PCL 更新至最新版或许可以解决这个问题……", Title, IsWarn:=True)
- End If
- Case NotifyLevel.Critical
- If IsCriticalErrorTriggered Then
- FormMain.EndProgramForce(ProcessReturnValues.Exception)
- Return
- End If
- IsCriticalErrorTriggered = True
- If CanFeedback(False) Then
- If MsgBox(ExFull & vbCrLf & vbCrLf & "是否反馈此问题?如果不反馈,这个问题可能永远无法得到解决!", MsgBoxStyle.Critical + MsgBoxStyle.YesNo, Title) = MsgBoxResult.Yes Then Feedback(False, True)
- Else
- MsgBox(ExFull & vbCrLf & vbCrLf & "将 PCL 更新至最新版或许可以解决这个问题……", MsgBoxStyle.Critical, Title)
- End If
- End Select
- '上报
- If Level >= NotifyLevel.AllUsers Then
- Telemetry("PCL 异常",
- "Level", GetStringFromEnum(Level),
- "Title", FilterUserName(FilterAccessToken(Title, "*"), "*"),
- "Exception", FilterUserName(FilterAccessToken(ExFull, "*"), "*"))
- End If
- End Sub
- '反馈
- Public Sub Feedback(Optional ShowMsgbox As Boolean = True, Optional ForceOpenLog As Boolean = False)
- On Error Resume Next
- FeedbackInfo()
- If ForceOpenLog OrElse (ShowMsgbox AndAlso MyMsgBox("若你在汇报一个 Bug,请点击 打开文件夹 按钮,并上传 Log(1~5).txt 中包含错误信息的文件。" & vbCrLf & "游戏崩溃一般与启动器无关,请不要因为游戏崩溃而提交反馈。", "反馈提交提醒", "打开文件夹", "不需要") = 1) Then
- OpenExplorer(PathExeFolder & "PCL\Log1.txt")
- End If
- OpenWebsite("https://github.com/Meloong-Git/PCL/issues/")
- End Sub
- Public Function CanFeedback(ShowHint As Boolean) As Boolean
- If False.Equals(PageSetupSystem.IsLauncherNewest) Then
- If ShowHint Then
- If MyMsgBox($"你的 PCL 不是最新版,因此无法提交反馈。{vbCrLf}请在更新后,确认该问题在最新版中依然存在,然后再提交反馈。", "无法提交反馈", "更新", "取消") = 1 Then
- UpdateCheckByButton()
- End If
- End If
- Return False
- Else
- Return True
- End If
- End Function
- ''' <summary>
- ''' 在日志中输出系统诊断信息。
- ''' </summary>
- Public Sub FeedbackInfo()
- On Error Resume Next
- Log("[System] 诊断信息:" & vbCrLf &
- "操作系统:" & My.Computer.Info.OSFullName & "(32 位:" & Is32BitSystem & ")" & vbCrLf &
- "剩余内存:" & Int(My.Computer.Info.AvailablePhysicalMemory / 1024 / 1024) & " M / " & Int(My.Computer.Info.TotalPhysicalMemory / 1024 / 1024) & " M" & vbCrLf &
- "DPI:" & DPI & "(" & Math.Round(DPI / 96, 2) * 100 & "%)" & vbCrLf &
- "MC 文件夹:" & If(McFolderSelected, "Nothing") & vbCrLf &
- "文件位置:" & PathExeFolder)
- End Sub
- '遥测
- Public Sub Telemetry([Event] As String, ParamArray Datas As String())
- If BuildType = BuildTypes.Debug Then Return '开发版不上传遥测
- If Not Settings.Get("SystemSystemTelemetry") Then Return '用户关闭了遥测
- If Not ClsBaseUrl.StartsWithF("http") Then Return '开源版没有设置遥测地址
- RunInNewThread(
- Sub()
- Try
- Log($"[System] 匿名数据上报:{[Event]}")
- Dim Url As String = $"{ClsBaseUrl}&Event={EscapeUtils.UrlEscape([Event])}"
- For i = 0 To Datas.Length - 1 Step 2
- Url &= "&" & EscapeUtils.UrlEscape(Datas(i)) & "=" & EscapeUtils.UrlEscape(Datas(i + 1).ReplaceLineEndings(vbCrLf))
- Next
- NetRequestByClient(Url, MakeLog:=False)
- Catch ex As Exception
- Log(ex, "匿名数据上报失败")
- End Try
- End Sub, "Telemetry", ThreadPriority.Lowest)
- End Sub
- '获取当前的堆栈信息
- Public Function GetStackTrace() As String
- Return (New StackTrace).GetFrames().Skip(1).
- Select(Function(f) f.GetMethod).
- Select(Function(f) $"{f.Name}({f.GetParameters.Select(Function(p) p.ToString).Join(", ")}) - {f.Module}").
- Join(vbCrLf).Replace(vbCrLf & vbCrLf, vbCrLf)
- End Function
- #End Region
- #Region "随机"
- Private ReadOnly Random As New Random
- ''' <summary>
- ''' 随机选择其一。
- ''' </summary>
- Public Function RandomOne(Of T)(objects As ICollection(Of T)) As T
- Return objects(RandomInteger(0, objects.Count - 1))
- End Function
- ''' <summary>
- ''' 取随机整数(包含)。
- ''' </summary>
- Public Function RandomInteger(min As Integer, max As Integer) As Integer
- Return Math.Floor((max - min + 1) * Random.NextDouble) + min
- End Function
- ''' <summary>
- ''' 将数组随机打乱。
- ''' </summary>
- <Extension> Public Iterator Function Shuffle(Of T)(Raw As IEnumerable(Of T)) As IEnumerable(Of T)
- Dim RawCopy As New List(Of T)(Raw)
- Do While RawCopy.Any
- Dim i As Integer = RandomInteger(0, RawCopy.Count - 1)
- Yield RawCopy(i)
- RawCopy.RemoveAt(i)
- Loop
- End Function
- #End Region
- End Module
- #Region "WPF"
- ''' <summary>
- ''' 对数据绑定进行加法运算,使用参数决定加数。
- ''' </summary>
- Public Class AdditionConverter
- Implements IValueConverter
- Public Function Convert(value As Object, targetType As Type, parameter As Object, culture As CultureInfo) As Object Implements IValueConverter.Convert
- If value Is Nothing Then Return 0
- Dim before As Double
- If Not Double.TryParse(value.ToString(), before) Then Return 0
- Dim scale As Double = 1
- If parameter IsNot Nothing Then Double.TryParse(parameter.ToString(), scale)
- Return before + scale
- End Function
- Public Function ConvertBack(value As Object, targetType As Type, parameter As Object, culture As CultureInfo) As Object Implements IValueConverter.ConvertBack
- If value Is Nothing Then Return Binding.DoNothing
- Dim before As Double
- If Not Double.TryParse(value.ToString(), before) Then Return Binding.DoNothing
- Dim scale As Double = 1
- If parameter IsNot Nothing Then Double.TryParse(parameter.ToString(), scale)
- If scale = 0 Then Return Binding.DoNothing
- Return before - scale
- End Function
- End Class
- ''' <summary>
- ''' 对数据绑定进行乘法运算,使用参数决定乘数。
- ''' </summary>
- Public Class MultiplicationConverter
- Implements IValueConverter
- Public Function Convert(value As Object, targetType As Type, parameter As Object, culture As CultureInfo) As Object Implements IValueConverter.Convert
- If value Is Nothing Then Return 0
- Dim before As Double
- If Not Double.TryParse(value.ToString(), before) Then Return 0
- Dim scale As Double = 1
- If parameter IsNot Nothing Then Double.TryParse(parameter.ToString(), scale)
- Return before * scale
- End Function
- Public Function ConvertBack(value As Object, targetType As Type, parameter As Object, culture As CultureInfo) As Object Implements IValueConverter.ConvertBack
- If value Is Nothing Then Return Binding.DoNothing
- Dim before As Double
- If Not Double.TryParse(value.ToString(), before) Then Return Binding.DoNothing
- Dim scale As Double = 1
- If parameter IsNot Nothing Then Double.TryParse(parameter.ToString(), scale)
- If scale = 0 Then Return Binding.DoNothing
- Return before / scale
- End Function
- End Class
- ''' <summary>
- ''' 将取反的 Boolean 绑定到 Visibility。
- ''' </summary>
- Public Class InverseBooleanToVisibilityConverter
- Implements IValueConverter
- Public Function Convert(value As Object, targetType As Type, parameter As Object, culture As CultureInfo) As Object Implements IValueConverter.Convert
- If value Is Nothing Then Return Visibility.Visible
- Dim boolValue As Boolean
- Return If(Boolean.TryParse(value.ToString(), boolValue), If(boolValue, Visibility.Collapsed, Visibility.Visible), Visibility.Visible)
- End Function
- Public Function ConvertBack(value As Object, targetType As Type, parameter As Object, culture As CultureInfo) As Object Implements IValueConverter.ConvertBack
- If value Is Nothing Then Return False
- Return If(TypeOf value Is Visibility, value <> Visibility.Visible, False)
- End Function
- End Class
- ''' <summary>
- ''' 将 Boolean 取反。
- ''' </summary>
- Public Class InverseBooleanConverter
- Implements IValueConverter
- Public Function Convert(value As Object, targetType As Type, parameter As Object, culture As CultureInfo) As Object Implements IValueConverter.Convert
- If value Is Nothing Then Return False
- Dim boolValue As Boolean
- Return If(Boolean.TryParse(value.ToString(), boolValue), Not boolValue, False)
- End Function
- Public Function ConvertBack(value As Object, targetType As Type, parameter As Object, culture As CultureInfo) As Object Implements IValueConverter.ConvertBack
- If value Is Nothing Then Return False
- Return If(Boolean.TryParse(value.ToString(), value), Not value, False)
- End Function
- End Class
- #End Region
|