[F#]Schedule Board (http://www.rumix.com/sb/) のファイルを変換・修復
// This file is in the public domain. | |
#r "System" | |
#r "System.Drawing" | |
#r "System.Windows.Forms" | |
open System | |
open System.IO | |
open System.Text | |
open System.Drawing | |
open System.Windows.Forms | |
type ExOpt<'a> = ExSome of 'a | ExErr of int | |
type MaybeErrorBuilder() = | |
member this.Bind(x: int * bool, f) = | |
if snd x then f() else ExErr (fst x) | |
member this.Return(x) = ExSome x | |
let maybeError = MaybeErrorBuilder() | |
let readstr (br:BinaryReader) = | |
let len = int <| br.ReadByte() | |
if len = 0 then "" else | |
let len = if len < 255 then len else int <| br.ReadUInt16() | |
br.ReadBytes len |> Encoding.Default.GetString | |
let writestr (bw:BinaryWriter) (s:string) = | |
let b = Encoding.Default.GetBytes s | |
if b.Length = 0 then | |
bw.Write 0uy | |
elif b.Length < 255 then | |
bw.Write (byte b.Length) | |
bw.Write b | |
else | |
bw.Write 255uy | |
bw.Write (uint16 b.Length) | |
bw.Write b | |
type Record() = | |
member val Type = 0 with get, set | |
member val Start = 0L with get, set | |
member val End = 0L with get, set | |
member val Modify = 0L with get, set | |
member val Color = 0 with get, set | |
member val Index = 0 with get, set | |
member val Text = "" with get, set | |
member val Id = "" with get, set | |
member val User = "" with get, set | |
member val Desc = "" with get, set | |
member r.Write(bw:BinaryWriter) = | |
bw.Write 0x12c | |
bw.Write 0x50002 | |
bw.Write r.Type // 0:新規, 1:修正, 2:削除 | |
bw.Write 0 | |
bw.Write r.Start | |
bw.Write 0 | |
bw.Write r.End | |
bw.Write 0 | |
bw.Write r.Modify | |
bw.Write r.Color | |
bw.Write r.Index | |
writestr bw r.Text | |
writestr bw r.Id | |
writestr bw r.User | |
writestr bw r.Desc | |
bw.Write 0uy | |
override r.ToString() = | |
sprintf "%d,%d,%d,%d,%d,%d,%d,%d,%d,\"%s\",\"%s\",\"%s\",\"%s\"" | |
r.Type | |
(r.Start |> int) (r.Start >>> 32 |> int) | |
(r.End |> int) (r.End >>> 32 |> int) | |
(r.Modify |> int) (r.Modify >>> 32 |> int) | |
r.Color r.Index r.Text r.Id r.User r.Desc | |
member r.Contains (rr:Record) = | |
rr.Type = 0 && r.Id = rr.Id && | |
((r.Start <= rr.Start && rr.Start < r.End) || | |
(r.Start < rr.End && rr.End <= r.End)) | |
let readrec (br:BinaryReader) = maybeError { | |
let r = Record() | |
do! 1, br.ReadInt32() = 0x12c | |
do! 2, br.ReadInt32() = 0x50002 | |
r.Type <- br.ReadInt32() | |
do! 3, br.ReadInt32() = 0 | |
r.Start <- br.ReadInt64() | |
do! 4, br.ReadInt32() = 0 | |
r.End <- br.ReadInt64() | |
do! 5, br.ReadInt32() = 0 | |
r.Modify <- br.ReadInt64() | |
r.Color <- br.ReadInt32() | |
r.Index <- br.ReadInt32() | |
r.Text <- readstr br | |
r.Id <- readstr br | |
r.User <- readstr br | |
r.Desc <- readstr br | |
do! 6, br.ReadByte() = 0uy | |
return r } | |
let readsch f = | |
use br = new BinaryReader(new FileStream(f, FileMode.Open)) | |
let ret = new System.Collections.Generic.List<Record>() | |
let rec loop() = | |
if br.PeekChar() = -1 then 0, 0L else | |
let pos = br.BaseStream.Position | |
match readrec br with | |
| ExErr e -> | |
e, pos | |
| ExSome r -> | |
ret.Add r | |
loop() | |
match loop() with a, b -> a, b, ret.ToArray() | |
let writecsv (tw:TextWriter) (recs:Record[]) = | |
recs |> Array.iteri (fun num r -> tw.WriteLine("{0},{1}", num, r)) | |
let rebuild (recs:Record[]) = | |
let recs = Array.copy recs | |
for r in recs do | |
match r.Type with | |
| 1 -> | |
recs.[r.Index].Type <- 3 | |
r.Type <- 0 | |
r.Index <- 0 | |
| 2 -> | |
recs.[r.Index].Type <- 3 | |
| _ -> | |
() | |
recs |> Array.iteri (fun i r -> | |
if r.Type = 0 && recs.[i + 1 ..] |> Array.exists r.Contains then | |
r.Type <- 4) | |
recs |> Array.filter (fun r -> r.Type = 0) | |
let suffix f sfx = | |
let dir = Path.GetDirectoryName f | |
let name = Path.GetFileNameWithoutExtension f | |
let ext = Path.GetExtension f | |
Path.Combine(dir, name + sfx + ext) | |
let convert f = | |
let e, pos, recs = readsch f | |
let fout = Path.ChangeExtension(f, ".csv") | |
use sw = new StreamWriter(fout, false, Encoding.Default) | |
writecsv sw recs | |
if e <> 0 then fprintfn sw "error,%d,%x" e pos | |
use sw2 = new StreamWriter(suffix fout "-2", false, Encoding.Default) | |
let recs2 = rebuild recs | |
writecsv sw2 recs2 | |
use bw = new BinaryWriter(new FileStream(suffix f "-2", FileMode.Create)) | |
for r in recs2 do r.Write bw | |
[<EntryPoint; STAThread>] do | |
let w = new Form(Text = "SCH 変換修復", AllowDrop = true) | |
w.Controls.Add (new Label(Text = "ここに .sch ファイルを DnD してください。", | |
Dock = DockStyle.Fill, | |
TextAlign = ContentAlignment.MiddleCenter)) | |
w.DragEnter.Add <| fun e -> | |
if e.Data.GetDataPresent DataFormats.FileDrop then | |
e.Effect <- DragDropEffects.Link | |
w.DragDrop.Add <| fun e -> | |
let files = e.Data.GetData(DataFormats.FileDrop) :?> string[] | |
if files <> null then | |
files | |
|> Array.filter (fun f -> Path.GetExtension(f).ToLower() = ".sch") | |
|> Array.iter convert | |
Application.Run w |
Attribute VB_Name = "csv2sch" | |
Option Explicit | |
Sub WriteStr(T$) | |
Dim L%, LB As Byte, Buf() As Byte | |
Buf = StrConv(T, vbFromUnicode) | |
L = UBound(Buf) + 1 | |
If L = 0 Then | |
LB = 0 | |
Put #1, , LB | |
ElseIf L < 255 Then | |
LB = L | |
Put #1, , LB | |
Put #1, , Buf | |
Else | |
LB = 255 | |
Put #1, , LB | |
Put #1, , L | |
Put #1, , Buf | |
End If | |
End Sub | |
Sub SCH生成() | |
Dim TMP&, TB As Byte, T&, S1&, S2&, E1&, E2&, M1&, M2&, C&, I&, Tx$, Id$, Us$, Ds$, Y% | |
Y = 1 | |
Open "C:\output.sch" For Binary Lock Write As #1 | |
While Cells(Y, 1) <> "" | |
T = Cells(Y, 2) | |
S1 = Cells(Y, 3) | |
S2 = Cells(Y, 4) | |
E1 = Cells(Y, 5) | |
E2 = Cells(Y, 6) | |
M1 = Cells(Y, 7) | |
M2 = Cells(Y, 8) | |
C = Cells(Y, 9) | |
I = Cells(Y, 10) | |
Tx = Cells(Y, 11) | |
Id = Cells(Y, 12) | |
Us = Cells(Y, 13) | |
Ds = Cells(Y, 14) | |
TMP = &H12C: Put #1, , TMP | |
TMP = &H50002: Put #1, , TMP | |
Put #1, , T | |
TMP = 0: Put #1, , TMP | |
Put #1, , S1 | |
Put #1, , S2 | |
TMP = 0: Put #1, , TMP | |
Put #1, , E1 | |
Put #1, , E2 | |
TMP = 0: Put #1, , TMP | |
Put #1, , M1 | |
Put #1, , M2 | |
Put #1, , C | |
Put #1, , I | |
WriteStr Tx | |
WriteStr Id | |
WriteStr Us | |
WriteStr Ds | |
TB = 0: Put #1, , TB | |
Y = Y + 1 | |
Wend | |
Close #1 | |
End Sub |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment